[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