## ********************************************************
##
## Name: bak
##
## Description:
## Create backup files as necessary to avoid overwrites.
##
## Parameters:
##
## Usage:
## before writing to a file $fname, call: bak $fname
## and the file will not get overwritten.
##
## renames like so: .bak, .ba2, .ba3, .ba4, etc.
##
## Comments:
##
proc bak { fname { levels 10 } } {
if { [ catch {
if { [ file exists $fname ] } {
set dir [ file dirname $fname ]
set files [ glob -nocomplain -path ${fname} .ba* ]
set i $levels
while { [ incr i -1 ] } {
if { [ lsearch -exact $files ${fname}.ba$i ] > -1 } {
file rename -force ${fname}.ba$i ${fname}.ba[ incr i ]
incr i -1
}
}
if { [ file exists ${fname}.bak ] } {
file rename -force ${fname}.bak ${fname}.ba2
}
file rename -force $fname ${fname}.bak
}
} err ] } {
return -code error "bak($fname $levels): $err"
}
}
## ********************************************************Vince updated example so works even if 'fname' contains strange glob-sensitive characters (which are hard to write in the Wiki). This requires Tcl 8.3Francois Vogel December 04 2005 The above code goes into an infinite loop if called with levels==0. I fixed it by adding:
if {$levels==0} {return}LES on Feb 15 2006: Maybe I am just doing something wrong, but the proc above doesn't really work as expected for me. So I took my own stab at it:
proc bak { fname { levels 5 } } {
if { ![ file exists [ file normalize "$fname" ] ] } {
return "$fname: no such file"
}
set copies [ list $fname ${fname}.bkp ]
for { set i 1 } { $i <= $levels } { incr i } {
lappend copies "${fname}.bkp${i}"
}
while { [ llength $copies ] >= 2 } {
set _source [ file normalize "[ @ [ lrange $copies end-1 end ] 0 ]" ]
set _target [ file normalize "[ @ [ lrange $copies end-1 end ] 1 ]" ]
catch { file copy -force $_source $_target }
set copies [ lreplace $copies end end ]
}
}WJG (05/05/13) I like the idea of this module, but I want to keep my backups kept separate from my working files. The follow modifications allow me to specify a separate backup directory. In this case it's hidden so that my desktop file manager isn't full of unwanted icons.
proc bak { fname args } {
# set some default values
set levels 5
set dir ./bak
foreach {a b } $args {
set a [string trimleft $a -]
set $a $b
}
if { ! [file exists $dir] } {
file mkdir $dir
}
if { [ file exists $fname ] } {
file copy -force $fname $dir
set fname $dir/[file tail $fname]
set files [ glob -nocomplain -path $fname .ba* ]
set i $levels
while { [ incr i -1 ] } {
if { [ lsearch -exact $files ${fname}.ba$i ] > -1 } {
file rename -force ${fname}.ba$i ${fname}.ba[ incr i ]
incr i -1
}
}
if { [ file exists ${fname}.bak ] } {
file rename -force ${fname}.bak ${fname}.ba2
}
file rename -force $fname ${fname}.bak
}
}
set fname "./test.txt"
set fp [open $fname w]
puts $fp "How Now Brown Cow!"
close $fp
for {set i 0} {$i < 5} {incr i} {
bak $fname -dir [file dirname]/.bak -levels 5
}