开发者

Tcl - Recursive walking and FTP upload

开发者 https://www.devze.com 2023-04-13 00:34 出处:网络
How can I do a recursive walk through a local folder in order to upload everything it has inside it to the desired ftp folder? Here\'s what I have so far :

How can I do a recursive walk through a local folder in order to upload everything it has inside it to the desired ftp folder? Here's what I have so far :

package require ftp

set host **
set user **
set pass **
set ftpdirectory **
set localdirectory **

proc upload {host user pass dir fileList} {
      set handle [::ftp::Open $host $user $pass]

     ftpGoToDir $handle $dir
      # some counters for our feedback string
      set j 1
      set k [llength $fileLis开发者_如何学运维t]

      foreach i $fileList {
        upload:status "uploading ($j/$k) $i"
        ::ftp::Put $handle $i
        incr j
}

  ::ftp::Close $handle
 }

 #---------------
 # feedback
 #---------------
 proc upload:status {msg} {
  puts $msg
 }

 #---------------
 # go to directory in server
 #---------------

 proc ftpGoToDir {handle path} {
     ::ftp::Cd $handle /
     foreach dir [file split $path] {
     if {![::ftp::Cd $handle $dir]} {
         ::ftp::MkDir $handle $dir
         ::ftp::Cd $handle $dir
     }
     }
 }

proc watchDirChange {dir intv {script {}} {lastMTime {}}} {
      set nowMTime [file mtime $dir]
      if [string eq $lastMTime ""] {
         set lastMTime $nowMTime
      } elseif {$nowMTime != $lastMTime} {
         # synchronous execution, so no other after event may fire in between
         catch {uplevel #0 $script}
         set lastMTime $nowMTime
      }
      after $intv [list watchDirChange $dir $intv $script $lastMTime]
 }

watchDirChange $localdirectory 5000 {
    puts stdout {Directory $localdirectory changed!}
    upload $host $user $pass $ftpdirectory [glob -directory $localdirectory -nocomplain *]
}

 vwait forever

Thanks in advance :)


You're already using the ftp package, so that means you've got tcllib installed. Good. That means in turn that you've got the fileutil package as well, and can do this:

package require fileutil

# How to do the testing; I'm assuming you only want to upload real files
proc isFile f {
    return [file isfile $f]
}
set filesToUpload [fileutil::find $dirToSearchFrom isFile]

The fileutil::find command is very much like a recursive glob, except that you specify the filter as a command instead of via options.

You might prefer to use rsync instead though; it's not a Tcl command, but it is very good and it will minimize the amount of data actually transferred.

0

精彩评论

暂无评论...
验证码 换一张
取 消