Db controll open file add search remove TEXT not decimal

[willienl]

Hi there i saw mod`s remove post`s
with requests about file open in tcl
many times i se no way to fix it and here on this
forum the talk about many times discussing it where
are those post so i can learn from that

here my script
can someone help me fixing the del option
thnx will

################ Set Db var`s ################
if {![file exists test.txt]} {
set fs [open test.txt a]
puts $fs "db script"
close $fs
}

################ Find args ################
bind pub - "!find" pub:search
proc pub:search {nick host hand channel args} {
set file "test.txt"
set found 0
set fs [open $file r]
while {![eof $fs]} {
gets $fs line
if {$line == $args} { set found 1 }
}
close $fs
if {$found} {
putquick "PRIVMSG $channel :$nick $args was found!"
} else {
putquick "PRIVMSG $channel :$nick $args was not found."
}
return 0
}

################ Add args ################
bind pub - "!add" pub:addin
proc pub:addin {nick host hand channel args} {
set file "test.txt"
set found 0
set fs [open $file r]
while {![eof $fs]} {
gets $fs line
if {$line == $args} { set found 1 }
}
close $fs
if {$found == "1"} {
putquick "PRIVMSG $channel :$args was found!"
} else { set fs [open $file a]
puts $fs "$args"
close $fs
putquick "PRIVMSG $channel :$args was add!"
}
return 0
}

################ Del args ################
bind pub - "!del" pub:del
proc pub:del {nick host hand channel args} {
set file "test.txt"
set found 0
set fs [open $file r]
while {![eof $fs]} {
gets $fs line
if {$line == $args} {
set found 1
set result $line }
}
close $fs
if {$found == "1"} {
putquick "PRIVMSG $channel :$args was found!"
} else { putquick "PRIVMSG $channel :$args was add!"
}
return 0
}

#the line to check if it is in my db file
#is done
#when i try to remove word3
#i get an error when i type !test 3 then not but nothing happend
#

bind pub - "!test pub:test
proc pub:test {nick host hand channel args} {
set file "test.txt"
set fp [open $file "r"]
set data [read -nonewline $fp]
close $fp

set lines [split $data "\n"]
set lines [lreplace $lines $args $args]

set fp [open $fp "w"]
puts $fp [join $lines "\n"]
close $fp
return 0
}



my file test.txt looks like this

word1
word2
word3
word4

[user]

i get an error when i type !test 3 then not but nothing happend

What error did you get? Read it - and don't use the argument name 'args' before you've read the proc manual. (it has a special meaning)

Here's a proc that might be of use to you:

Code: Select all

# imagine that the lines in your file are elements in a list
# and use this proc like 'lreplace' (check the manual)
#
# to delete the last line: freplace your.txt end
# to replace the first line: freplace your.txt 0 0 "New first line"

proc freplace {file args} {
	# check arguments
	switch [llength $args] {
		1 {lappend args [lindex $args 0]}
		2 - 3 {}
		default {error "usage: freplace <fileName> <firstLine> \[lastLine \[replacementData\]\]"}
	}
	# read file
	set f [open $file]
	set lines [split [read $f] \n]
	close $f
	# replace line(s)
	set lines [eval [list lreplace $lines] $args]
	# write file
	set f [open $file w]
	puts -nonewline $f [join $lines \n]
	close $f
}

[willienl]

when type !del test23
i get

Tcl error [pub:del]: bad index "test23": must be integer or end?-integer?

when type !del 2
i get none
with my own way of try
i'll ty your example and i tell if i can use it or not
it is for me i don't matter line nr`s
i must be able to delete the word somthing on line 200 of 600 lines
600 lines each line an user ident or host

like
nick1
nick2
nick3
nick4

[willienl]

i have try it don't work
get same error as my own script

[user]

i have try it don't work
get same error as my own script

The error is from 'lreplace' - go read the manual.

Here's a couple of procs to give you some ideas (not tested, so there might be bugs)

1: using 'string match -nocase' on every line.
This one writes every non-matching line to a temp file then overwrites the original at the end if there were any matches

Code: Select all

proc fdel {file what} {
	set i 0
	while {[file exists $file.[incr i]]} {}
	set file2 $file.$i

	set f1 [open $file]
	set f2 [open $file2 w]
	set n 0

	while {[gets $f1 line]>-1} {
		if {[string match -nocase $what $line]} {
			incr n
		} {
			puts $f2 $line
		}
	}
	close $f1
	close $f2

	if $n {
		file rename -force $file2 $file
	} {
		file delete $file2
	}
	set n
}

2: using 'lsearch' on the entire contents of the file (case sensitive)
This one reads the entire file, does the deleting and then creates the file all over if any lines were deleted. It lets you decide the mode used for 'lsearch' and also has an option for replacing all matching lines or just the first one.

Code: Select all

proc fdel2 {file what {mode -glob} {all 0}} {
	set f [open $file]
	set data [split [read $f] \n]
	close $f
	set n 0
	[expr {$all?"while":"if"] {[set i [lsearch $mode $data $what]]>-1} {
		set data [lreplace $data $i $i]
		incr n
	}
	if $n {
		set f [open $file w]
		puts -nonewline $f [join $data \n]
		close $f
	}
	set n
}

...they both return the number of lines deleted