## ********************************************************
##
## 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.3
Francois 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
}