Search/Replace in tcl HELP!

[cluelesspanda]

I'm tring to do search & replace with tcl. I have 2 files, one with search key and its corresponding replacement value, and a target text file. The file with key/value is simple - it has key/values space delimited in 2 colums:

ex. (first element is the key, 2nd is the replacement)

blue black
red yellow
white green

The target text file is just text like this: ("xxx".. is just irrevant text)

xxx xxx xxxxx xxxx
xxx blue xxxxx aaaa - where "aaaa" is replaced with "black"
xxx red xxxxx bbbb - where "bbbb" is to be replaced with yel

etc.

does anyone have an efficient elegant way to do this? thanks!!

cia,
clueless in class

 

[esjo]

I tried this to solve your problem:
( You'd only to assign the values of "aaaa" "bbbb" to the lines of your substitution table ( second file or third column in your substitution file ?? ))

1. Reading your substitution file to a list:

set ytable ""
set inp [ open substitutionfile r ]
while { [ gets $inp line ] >= 0 } { lappend $line }
close $inp

2. Run substitution to a temporary file

set inp [ open targetfile r ]
set out [ open newfile w ]
while { [ gets $inp line ] >= 0 } {
foreach val $ytable { if { [ regsub "\(.*[ lindex $val 0 ].*\)$pattern\(.*\)" $line "\\1[ lindex $val 1 ]\\2" line ] > 0 } break }
puts $out $line
}

close $newfile ; close $targetfile

--> "$pattern" is the variable value of "aaaa", "bbbb" in your example, that has to be assigned to the lines of your substitution file.

3. Rewrite to your target file

file copy -force $newfile $targetfile

4. Hope all works fine ;-)

 

[cluelesspanda]

Hi Esjo! thanx for your time! Greatly appreciated.

- substitution file -
red blue
black grey
white green
orange gold

- target text file - (where xx.. is irrevant)

xx orange xx xxx xx xx AAA>> xx xxx xxx
x red xx xxx xx xx AAA>> xx xxx xxx
xx black xx xxx xx xx AAA>> xx xxx xxx
xx xxx xx xxx xx xx AAA>> xx xxx xxx
xx xxxx xx xxx xx xx AAA>> xx xxx xxx
..

- what I would like to see after substitution -
(where set pattern "AAA&quot

xx orange xx xxx xx xx gold>> xx xxx xxx
x red xx xxx xx xx blue>> xx xxx xxx
xx black xx xxx xx xx grey>> xx xxx xxx
xx xxx xx xxx xx xx AAA>> xx xxx xxx
xx xxxx xx xxx xx xx AAA>> xx xxx xxx

so for $line where there's an occurance of one of the
search keys, such as red/black/orange etc, their
corresponding replacement values (such as "gold" replacing
"AAA" for a line with occurance of "orange", and "blue"
replacing "AAA" for a one with "red" - but "AAA" does not
get replaced for a line which does not contain any search
keys (such as orange/red/black etc)...

i did try out your code, but it seems that the newly created
file and the original target text are the same... i'm not sure where things are going wrong...

i'll keep on looking @ your code, but if you would help me more, that would definitely be great....! thanks again!

 

[esjo]

There was a little omission in the third line - sorry !
Here again the complete code:
#-----------------------------------------------------------
set pattern "AAA"

set table ""
set inp [ open $substitutionfile r ]
while { [ gets $inp line ] >= 0 } { lappend table $line }
close $inp

set inp [ open $targetfile r ]
set out [ open $newfile w ]
while { [ gets $inp line ] >= 0 } {
foreach val $table {
if { [ regsub "\(.*[ lindex $val 0 ].*\)$pattern\(.*\)" $line "\\1[ lindex $val 1 ]\\2" line ] > 0 } break
}
puts $out $line
}

close $out ; close $inp
file copy -force $newfile $targetfile
#-----------------------------------------------------------
Now the little script should do what you want.

Greetings
esjo

 

[AviaTraining]

Check out the string map command (introduced in Tcl 8.1.1). It does exactly what you want: it takes a list mapping input character patterns to output character patterns and a string to process, and returns the result of the replacement process. For example:

set translation {
  red   "brilliant scarlet"
  blue  aquamarine
}

set text {
Roses are red.
Violets are blue.
And this is a silly test.
}

puts [string map $translation $text]

results in:

Roses are brilliant scarlet.
Violets are aquamarine.
And this is a silly test.

- Ken Jones, President, ken@avia-training.com
Avia Training and Consulting,

http://www.avia-training.com

866-TCL-HELP (866-825-4357) US Toll free
415-643-8692 Voice
415-643-8697 Fax

 

[esjo]

It's a nice idea to use the "string map"-command, but, sorry, I think it's not the solution for the original problem.
The purpose is, to find a pattern "blue" an then to replace another string "aaaa" (not the pattern) at the same line with a subsitution value "black" , that depends on the search pattern.
I think, a simple string map command doesn't perform this.

esjo

 

[ulis]

If I understood your need:

  lappend olines {xxx xxx xxxxx xxxx}
  lappend olines {xxx blue xxxxx aaaa}
  lappend olines {xxx red xxxxx bbbb}
  set nlines {}
  set n 0
  foreach line $olines   {
    if {[llength $line] != 4}     { error "wrong line $n: \"$line\"" }
    foreach {fill1 key fill2 value} $line     {
      switch -- $key       {
        blue  { set value black }
        red   { set value yellow }
      }
    }
    lappend nlines [list $fill1 $key $fill2 $value]
    incr n
  }
  puts [join $nlines \n]

Each old line is splitted in words and the second word is tested for modification of the fourth. Then the words are concatened to become a new line.

HTH

ulis

 

[marsd]

As long as everyone is getting in on this I might
as well.
If your file format is as described then using
scan to split the line into n variables,checking
var2 for match in array with key->value pairs
and then replacing var7 will do what you want
ala awk.

Something like this may get you started

 proc loadmatches {fname} {
global aname               
                if {![file exists $fname]} {
                    error "No file named: $fname"
               }

                array set aname {}
                if {![catch {set fd [open $fname r]}]} {
                     set data [read $fd]
                     close $fd
                     foreach line [split $data \n] {
                                 scan $line "%s %s" key val
                                 set aname($key) $val
                     }
                 return [array size aname]
                }
                error "Could not open $fname"
} 

proc checkStuff {fname} {
 global aname

                      if {![file exists $fname]} {
                           error "Filename: $fname, does not exist."
                      }

                  if {![catch {set fd [open $fname r]}]} {
                        set data [read $fd]
                        close $fd
                        foreach line [split $data \n] {
                            scan $line "%s %s %s %s %s %s %s %s" var1 var2 var3 var4 var5 var6 var7 var8
                            foreach poss [array name aname] {
                                         if {[string compare $var2 $poss] == 0} {set var7 $aname($poss)}
                                         
                            }
                            puts "$var1 $var2 $var3 $var4 $var5 $var6 $var7 $var8"
                         }
                        return   
                  }
error "Could not open: $fname"
}

My run looks like:
unset aname
(mars) 78 % loadmatches "/home/mars/tt.txt"
3
(mars) 79 % checkStuff "/home/mars/tt1.txt"
xx orange xx xxx xx xx moandbetterstuff xx
x red xx xxx xx xx stuff xx
xx black xx xxx xx xx mostuff xx
xx xxx xx xxx xx xx AAA>> xx
xx xxxx xx xxx xx xx AAA>> xx

HTH