[Starkit] Error when copying files from startkit to disk (with
test cases)
Guaca Mole
guacamole1234 at yahoo.com
Tue Jan 27 09:28:33 CET 2004
Hi Vince,
I just tried it, replacing all tcl::CopyDirectory and
still get the same error.
This procedure is for copying directories, not files?
So maybe is the Core code Andreas mentioned?
--- Vince Darley <vince.darley at eurobios.com> wrote:
> I believe tcl::CopyDirectory (in init.tcl) is buggy.
> Try this:
>
> proc tcl::CopyDirectory {action src dest} {
> set nsrc [file normalize $src]
> set ndest [file normalize $dest]
>
> if {[string equal $action "renaming"]} {
> # Can't rename volumes. We could give a more
> precise
> # error message here, but that would break the test
> suite.
> if {[lsearch -exact [file volumes] $nsrc] != -1} {
> return -code error "error $action \"$src\" to\
> \"$dest\": trying to rename a volume or move
> a directory\
> into itself"
> }
> }
> if {[file exists $dest]} {
> if {$nsrc == $ndest} {
> return -code error "error $action \"$src\" to\
> \"$dest\": trying to rename a volume or move
> a directory\
> into itself"
> }
> if {[string equal $action "copying"]} {
> # We used to throw an error here, but, looking
> more closely
> # at the core copy code in tclFCmd.c, if the
> destination
> # exists, then we should only call this
> function if -force
> # is true, which means we just want to
> over-write. So,
> # the following code is now commented out.
> #
> # return -code error "error $action \"$src\"
> to\
> # \"$dest\": file already exists"
> } else {
> # Depending on the platform, and on the current
> # working directory, the directories '.', '..'
> # can be returned in various combinations.
> Anyway,
> # if any other file is returned, we must signal
> an error.
> set existing [glob -nocomplain -directory $dest
> * .*]
> eval [list lappend existing] \
> [glob -nocomplain -directory $dest -type
> hidden * .*]
> foreach s $existing {
> if {([file tail $s] != ".") && ([file tail $s] !=
> "..")} {
> return -code error "error $action \"$src\" to\
> \"$dest\": file already exists"
> }
> }
> }
> } else {
> if {[string first $nsrc $ndest] != -1} {
> set srclen [expr {[llength [file split $nsrc]]
> -1}]
> set ndest [lindex [file split $ndest] $srclen]
> if {$ndest == [file tail $nsrc]} {
> return -code error "error $action \"$src\" to\
> \"$dest\": trying to rename a volume or move a
> directory\
> into itself"
> }
> }
> file mkdir $dest
> }
> # Have to be careful to capture both visible
> and hidden files.
> # We will also be more generous to the file
> system and not
> # assume the hidden and non-hidden lists are
> non-overlapping.
> #
> # On Unix 'hidden' files begin with '.'. On
> other platforms
> # or filesystems hidden files may have other
> interpretations.
> set filelist [concat [glob -nocomplain
> -directory $src *] \
> [glob -nocomplain -directory $src -types
> hidden *]]
>
> foreach s [lsort -unique $filelist] {
> if {([file tail $s] != ".") && ([file tail $s] !=
> "..")} {
> file copy -force $s [file join $dest [file tail
> $s]]
> }
> }
> return
> }
>
> _____________________________________________
> Starkit mailing list - Starkit at equi4.com
> http://www.equi4.com/mailman/listinfo/starkit
__________________________________
Do you Yahoo!?
Yahoo! SiteBuilder - Free web site building tool. Try it!
http://webhosting.yahoo.com/ps/sb/
More information about the Starkit
mailing list