in tcl, how do I replace a line in a file? - file

let's say I opened a file, then parsed it into lines. Then I use a loop:
foreach line $lines {}
inside the loop, for some lines, I want to replace them inside the file with different lines. Is it possible? Or do I have to write to another temporary file, then replace the files when I'm done?
e.g., if the file contained
AA
BB
and then I replace capital letters with lower case letters, I want the original file to contain
aa
bb
Thanks!

for plain text files, it's safest to move the original file to a "backup" name then rewrite it using the original filename:
Update: edited based on Donal's feedback
set timestamp [clock format [clock seconds] -format {%Y%m%d%H%M%S}]
set filename "filename.txt"
set temp $filename.new.$timestamp
set backup $filename.bak.$timestamp
set in [open $filename r]
set out [open $temp w]
# line-by-line, read the original file
while {[gets $in line] != -1} {
#transform $line somehow
set line [string tolower $line]
# then write the transformed line
puts $out $line
}
close $in
close $out
# move the new data to the proper filename
file link -hard $filename $backup
file rename -force $temp $filename

In addition to Glenn's answer. If you would like to operate on the file on a whole contents basis and the file is not too large, then you can use fileutil::updateInPlace. Here is a code sample:
package require fileutil
proc processContents {fileContents} {
# Search: AA, replace: aa
return [string map {AA aa} $fileContents]
}
fileutil::updateInPlace data.txt processContents

If this is Linux it'd be easier to exec "sed -i" and let it do the work for you.

If it's a short file you can just store it in a list:
set temp ""
#saves each line to an arg in a temp list
set file [open $loc]
foreach {i} [split [read $file] \n] {
lappend temp $i
}
close $file
#rewrites your file
set file [open $loc w+]
foreach {i} $temp {
#do something, for your example:
puts $file [string tolower $i]
}
close $file

set fileID [open "lineremove.txt" r]
set temp [open "temp.txt" w+]
while {[eof $fileID] != 1} {
gets $fileID lineInfo
regsub -all "delted information type here" $lineInfo "" lineInfo
puts $temp $lineInfo
}
file delete -force lineremove.txt
file rename -force temp.txt lineremove.txt

For the next poor soul that is looking for a SIMPLE tcl script to change all occurrences of one word to a new word, below script will read each line of myfile and change all red to blue then output the line to in a new file called mynewfile.
set fin "myfile"
set fout "mynewfile"
set win [open $fin r]
set wout [open $fout w]
while {[gets $win line] != -1} {
set line [regsub {(red)} $line blue]
puts $wout $line
}
close $win
close $wout

Related

Tcl strings to middle of binary file without overwriting its conten

I have a binary file
in which I am trying to add a string in the middle of the file
(lets say after 10 Bytes)
I succees to overwrite the file with my string - but not to append
appreciate if someone can tell how can I append the string.
Here is my code example:
proc write_bit_header {} {
set bit_hdr "#Here is my new string to be added#"
set bit_hdr_len [string length ${bit_hdr}]
set outBinData [binary format a${bit_hdr_len} ${bit_hdr}]
set fp [open "binfile" "a+b"]
fconfigure $fp -translation binary
seek $fp 10
puts -nonewline $fp $outBinData
close $fp
}
When you write to the middle of a file (which you'd use the mode r+b for), none of the other bytes in the file move around. They're still at exactly the same offsets within the file that they were beforehand. If you're writing a fixed-size binary record into the file, this is exactly what you want! However, if you're writing a variable sized record, you have to:
read all the data that is going to go after the bytes that you want to write
seek to the place where you want to do the insert/replace
write the data that you are inserting
write the data that you read in step 1
truncate the file (in case what you wrote in step 3 is shorter than what you were replacing).
Yes, this is non-trivial!
proc insertData {filename dataToInsert insertionPoint {firstAfterByte ""}} {
# If you don't give the end of the range to overwrite, it's zero-length
if {$firstAfterByte eq ""} {
set firstAfterByte $insertionPoint
}
set f [open $filename "r+b"]
chan seek $f $firstAfterByte
set suffixData [chan read $f]
chan seek $f $insertionPoint
chan puts -nonewline $f $dataToInsert
chan puts -nonewline $f $suffixData
chan truncate $f
close $f
}
It's much easier when you're appending, as you are not having to move around any existing data and never need to truncate. And you can use the ab mode so that you don't need to seek explicitly.
proc appendData {filename dataToAppend} {
set f [open $filename "ab"]
puts -nonewline $f $dataToAppend
close $f
}
As you can see, the insertion code is quite a lot more tricky. It runs quite a bit of a risk of going wrong too. It's better to use a working copy file, and then replace the original at the end:
proc insertDataSafely {filename dataToInsert insertionPoint {firstAfterByte ""}} {
set f_in [open $filename "rb"]
set f_out [open ${filename}.tmp "wb"]
try {
chan copy $f_in $f_out $insertionPoint
puts -nonewline $f_out $dataToInsert
if {$firstAfterByte ne ""} {
chan seek $f_in $firstAfterByte
}
chan copy $f_in $f_out
chan close $f_in
chan close $f_out
} on ok {} {
file rename ${filename}.tmp $filename
} on error {msg opt} {
file delete ${filename}.tmp
# Reraise the error
return -options $opt $msg
}
}
Of course, not all files take kindly to this sort of thing being done in the first place, but the ways in which modifying an arbitrary file can make things go haywire is long and thoroughly out of scope for this question.

Save all Data in array, Filter out duplicated Data, Compare Data between arrays and Removed the matched Data

I have some problems regarding my script.
The problems are:
The value of $str or #matchedPath sometimes blank when I print out. It is not random, it happen only to certain Path in the table.txt file, which I can't figure it out, why?
How to print like the outcome, because I can't find the correct file location or directory of table.txt file because I have put all the path location in an array, filtered it and compared with the matched correct file location of table.txt, because of this, some location is missing when printed out.
Example path that the /home/is/latest/table.txt files contain, the bold texts is the wanted path in table.txt,
##WHAT PATH IS_THAT,Backup
a b/c/d B
a b/c/d/e B
a b/c/d/e/f B
a b/c/d/g B
Example path that the /home/are/latest/table.txt files contain, the middle texts is the wanted path in table.txt,
##WHAT PATH IS_THAT,Backup
a b/c/d/j B
e.g. list.txt file contains,
rty/b
uio/b/c
qwe/b/c/d
asd/b/c/d/e
zxc/b/c/d/e/f
vbn/c/d/e
fgh/j/k/l
Expected outcome:
Unmatched Path : b/c/d/g
table.txt file location: /home/is/latest/table.txt
Unmatched Path : b/c/d/j
table.txt file location: /home/are/latest/table.txt
Below is my detailed script,
#!/usr/perl/5.14.1/bin/perl
# I want to make a script that automatically compare the path in table.txt with list.txt
#table.txt files is located under a parent directory and it differs in the subdirectory.
#There is about 10 table.txt files and each one of it need to compare with list.txt
#The objective is to print out the path that are not in the list.txt
use strict;
use warnings;
use Switch;
use Getopt::Std;
use Getopt::Long;
use Term::ANSIColor qw(:constants);
use File::Find::Rule;
use File::Find;
use File::Copy;
use Cwd;
use Term::ANSIColor;
my $path1='/home'; #Automatically search all table.txt file in this directory even in subdirectory
my $version='latest'; #search the file specified subdirectory e.g. /home/is/latest/table.txt and /home/are/latest/table.txt
my $path2='/list.text'; #there is about 10 table.txt files which contain specified paths in it.
$path1 =~ s/^\s+|\s+$//g;
$version =~ s/^\s+|\s+$//g;
$path2 =~ s/^\s+|\s+$//g;
my #files = File::Find::Rule->file()
->name( 'table.txt' )
->in( "$path1" );
my #symlink_dirs = File::Find::Rule->directory->symlink->in($path1); #If the directory is a symlink, in my case 'latest' is a symlink directory
print colored (sprintf ("\n\n\tSUMMARY REPORT"),'bold','magenta');
print "\n\n_______________________________________________________________________________________________________________________________________________________\n\n";
if ($version eq "latest")
{
foreach my $dir (#symlink_dirs)
{
my #filess = File::Find::Rule->file()
->name( 'table.txt' )
->in( "$path1" );
my $symDir=($dir."/"."table.txt");
$symDir =~ s/^\s+|\s+$//g;
my $wantedPath=$symDir;
my $path_1 = $wantedPath;
function($path_1);
}
}
else
{
for my $file (#files)
{
if ($file =~ m/.*$version.*/)
{
my $wantedPath=$file;
my $path_1 = $wantedPath;
function($path_1);
}
}
}
sub function
{
my $path_1 = $_[0];
open DATA, '<', $path_1 or die "Could not open $path_1: $!";
my $path_2 = "$path2";
open DATA1, '<', $path_2 or die "Could not open $path_2: $!";
################# FOCUSED PROBLEM AREA ##############################
my #matchedPath;
my #matched_File_Path;
my #unmatchedPath;
my #unmatched_File_Path;
my #s2 = <DATA1>;
while(<DATA>)
{
my $s1 = $_;
if ($s1 =~ /^#.*/)
{
next;
}
if ($s1 =~ /(.*)\s+(.*)\s+(.*)\s+/)
{
my $str=($2);
$str =~ s/\s+//g;
for my $s2 (#s2)
{
if ($s2 =~ /.*$str/)
{
push #matchedPath,$str;
push #matched_File_Path,$path_1;
print "matched Path: $str\n\t$path_1\n"; #I don't understand, sometimes I get empty $str value in this. Can anyone help me?
last;
}
else
{
#print "unmatch:$str\n\t$path_1\n";
push #unmatchedPath,$str;
#unmatched_File_Path,$path_1;
}
}
}
}
foreach (#unmatchedPath)
{print "unmatch path: $_\n";}
foreach (#matchedPath)
{print "\nmatch path: $_\n\n";}
foreach (#unmatched_File_Path)
{print "unmatch File Path: $_\n";}
foreach (#matched_File_Path)
{print "match File Path: $_\n";}
my #filteredUnmatchedPath = uniq(#unmatchedPath);
my #filteredUnmatched_IP_File_Path =uniq(#unmatched_IP_File_Path);
#filteredUnmatchedPath = grep {my $filteredPath = $_; not grep $_ eq $filteredPath, #matchedPath} #filteredUnmatchedPath;
}
print "#filteredUnmatchedPath\n";
print "#filteredUnmatched_IP_File_Path\n";
sub uniq
{
my %seen;
grep !$seen{$_}++, #_;
}
close(DATA);
close(DATA1);
print "_________________________________________________________________________________________________________________________________________________________\n\n";
I think using hashes is much simpler here
here's what I tried:
you will have to replace #all_path with your array containing every path where table is present
use strict;
use warnings;
my #all_path =("some/location/table.txt","some/location_2/table.txt");
my %table_paths;
my %list_paths;
foreach my $path (#all_path)
{
open (my $table, "<", $path) or die ("error opening file");
#we create hash, each key is a path
while (<$table>)
{
chomp;
#only process lines starting with "a" as it seems to be the format of this file
$table_paths{(split)[1]}=$path if (/^a/); #taking the 2nd element in each line
}
close $table;
}
open (my $list, "<", "list.txt") or die ("error opening file");
#we create hash, each key is a path
while (<$list>)
{
chomp;
$list_paths{$_}=1;
}
close $list;
#now we delete from table_paths common keys with list, that lefts unmathed
foreach my $key (keys %table_paths)
{
delete $table_paths{$key} if (grep {$_ =~ /$key$/} (keys %list_paths));
}
#printing unmatched keys
print "unmatched :$_\nlocation: $table_paths{$_}\n\n" foreach keys %table_paths;
inputs
in some/location/table.txt
##WHAT PATH IS_THAT,Backup
a b/c/d B
a b/c/d/e B
a b/c/d/e/f B
a b/c/d/g B
in some/location_2/table.txt
##WHAT PATH IS_THAT,Backup
a b/c/d/j B
in list.txt
rty/b
uio/b/c
qwe/dummyName/b/c/d
asd/b/c/d/e
zxc/b/c/d/e/f
vbn/c/d/e
fgh/j/k/l
output:
unmatched: b/c/d/g
location: some/location/table.txt
unmatched: b/c/d/j
location: some/location_2/table.txt

appending line to a file in a specific location using tcl

I am trying to do this:
I have a text file which has a line starting with the specific pattern:
vvdd vdd
I need to locate this line and insert another line following this with a pattern vvss vss
All the other lines below the original line has to be displaced accordingly.
Here is my code so far which inserts into a wrong location:
set filename "path265.spi"
set line_no 0
set count 0
set pattern "vvdd vdd"
set fp [open $filename r+]
while {[gets $fp line] != -1} {
incr count 1
if {[regexp $pattern $line]} {
set line_no $count
}
}
seek $fp 0
for {set i 0} {$i<$line_no} {incr i} {gets $fp replace}
puts $fp "\nvvnw vnw 0 1.08"
puts $line_no
puts $count
close $fp
You can use ::fileutil::updateInPlace to simplify things.
package require fileutil
proc change {pattern newtext data} {
set res {}
foreach line [split $data \n] {
lappend res $line
if {[regexp $pattern $line]} {
lappend res $newtext
}
}
return [join $res \n]
}
::fileutil::updateInPlace path265.spi {change "^vvdd vdd" "vvss vss"}
The updateInPlace command takes a file name and a command prefix. It adds the contents of the file to that command prefix and invokes it, then writes the result back to to file.
In this case, the command called iterates through the lines of the file, adding $newtext after every line that matches $pattern. This is just one way to write the procedure for making the change. If only the first match is relevant, this could be used:
proc change {pattern newtext data} {
set lines [split $data \n]
set index [lsearch -regexp $lines $pattern]
if {$index >= 0} {
set lines [linsert $lines $index+1 $newtext]
}
return [join $lines \n]
}
etc.
Documentation: fileutil package, foreach, if, lappend, linsert, lsearch, package, proc, regexp, return, set, split

append a string in a file via tcl

i want to open up a pre-existed file and want to add a string inside the file one line before it sees the word 'exit' inside the file. the word 'exit' will always be the last line inside the file, so we can also see this as " add the string one line above the last line" problem. in other words, I want to append this string inside the file. here is example
Example.tcl (before)
AAAAAAA
BBBBBBB
CCCCCC
exit
Example.tcl (after)
AAAAAAA
BBBBBBB
CCCCCC
new_word_string
exit
Any suggestions are most welcome.
Working code:
Open the file for reading, and also open a temporary file:
set f1 [open $thefile]
set f2 [file tempfile]
Read one line at a time until all lines have been read. Look at the line. If it is the string "exit", print the new string to the temporary file. The write the line you read to the temporary file.
while {[set line [chan gets $f1]] ne {}} {
if {$line eq "exit"} {
chan puts $f2 $thestring
}
chan puts $f2 $line
}
Close the file and reopen it for reading.
chan close $f1
set f1 [open $thefile w]
Rewind the temporary file to the start position.
chan seek $f2 0
Read the entire contents of the temporary file and print them to the file.
chan puts -nonewline $f1 [chan read -nonewline $f2]
Close both files.
chan close $f1
chan close $f2
And we're done.
You could use a string buffer instead of a temporary file with minimal changes, to wit:
set f [open $thefile]
set tempstr {}
while {[set line [chan gets $f]] ne {}} {
if {$line eq "exit"} {
append tempstr $thestring\n
}
append tempstr $line\n
}
chan close $f
set f [open $thefile w]
chan puts -nonewline $f $tempstr
chan close $f
Documentation: append, chan, if, open, set, while
You could farm the work out to an external command (Tcl was written as a glue language after all):
% exec cat example.tcl
AAAAAAA
BBBBBBB
CCCCCC
exit
% set new_line "this is the new line inserted before exit"
this is the new line inserted before exit
% exec sed -i "\$i$new_line" example.tcl
% exec cat example.tcl
AAAAAAA
BBBBBBB
CCCCCC
this is the new line inserted before exit
exit

How to look for the difference between two large files in tcl?

I have two files, the some of the contents of these might be common in both. (say file A.txt and file B.txt)
Both the files are sorted files.
I need to get the difference of file A.txt and B.txt, ie, a file C.txt which has contents of A except the common contents in both.
I used the typical search and print algorithm, ie, took a line from A.txt, searched in B.txt, if found, print nothing in C.txt, else print that line in C.txt.
But, I am dealing with files with huge # of contents, and thus, it throws error: failed to load too many files. (Though it works fine for smaller files)
Can anybody suggest more efficient way of getting C.txt?
Script to be used: TCL only!
First off, the too many files error is an indication that you're not closing a channel, probably in the B.txt scanner. Fixing that is probably your first goal. If you've got Tcl 8.6, try this helper procedure:
proc scanForLine {searchLine filename} {
set f [open $filename]
try {
while {[gets $f line] >= 0} {
if {$line eq $searchLine} {
return true
}
}
return false
} finally {
close $f
}
}
However, if one of the files is small enough to fit into memory reasonably, you'd be far better reading it into a hash table (e.g., a dictionary or array):
set f [open B.txt]
while {[gets $f line]} {
set B($line) "any dummy value; we'll ignore it"
}
close $f
set in [open A.txt]
set out [open C.txt w]
while {[gets $in line]} {
if {![info exists B($line)]} {
puts $out $line
}
}
close $in
close $out
This is much more efficient, but depends on B.txt being small enough.
If both A.txt and B.txt are too large for that, you are probably best doing some sort of processing by stages, writing things out to disk in-between. This is getting rather more complex!
set filter [open B.txt]
set fromFile A.txt
for {set tmp 0} {![eof $filter]} {incr tmp} {
# Filter by a million lines at a time; that'll probably fit OK
for {set i 0} {$i < 1000000} {incr i} {
if {[gets $filter line] < 0} break
set B($line) "dummy"
}
# Do the filtering
if {$tmp} {set fromFile $toFile}
set from [open $fromFile]
set to [open [set toFile /tmp/[pid]_$tmp.txt] w]
while {[gets $from line] >= 0} {
if {![info exists B($line)]} {
puts $to $line
}
}
close $from
close $to
# Keep control of temporary files and data
if {$tmp} {file delete $fromFile}
unset B
}
close $filter
file rename $toFile C.txt
Warning! I've not tested this codeā€¦

Resources