Version 13 of Simple ftp uploader

Updated 2008-03-08 18:50:05 by thgr

WJG 23/11/05. Having made a photoalbum, PhotoAlbum -A Web Gallery Creation Tool it's time to upload the files to the remote server using ftp.


 package require Tk

 catch { console show }

 # load necessary packages
 package require ftp 
 package require ftp::geturl

 #---------------
 # set appropriate values...
 #---------------
 set host *******
 set user *******
 set pass *******
 set directory /

 #---------------
 # transfer files to server
 #---------------

 proc upload {host user pass dir fileList} {

  set handle [::ftp::Open $host $user $pass]

  # some counters for our feedback string
  set j 1
  set k [llength $fileList]


  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
 }

 #--------------- 
 # create filelist
 #---------------
 set files ""
 foreach i {jpg html css} {
  upload $host $user $pass $directory [glob -nocomplain *.$i]
 }

RLH 2006-Apr-05: Is there a reason Tk is required for this?


Pierre Coueffin 2006-Apr-12: Why does it need the variable "files"?

I'd be tempted to replace:

 if 0 {
  #--------------- 
  # create filelist
  #---------------
  set files ""
  foreach i {jpg html css} {
   upload $host $user $pass $directory [glob -nocomplain *.$i]
  }
 }

with

 if 0 {
  #--------------- 
  # create filelist
  #---------------
  upload $host $user $pass $directory [glob -nocomplain *.jpg *.html *.css]
 }

Unless I'm missing something subtle about how glob works.


thgr 2008-Mar-08: I needed to transfer whole directories:

ftpUpload $myHost $myUser $myPasswd $localDirctory $hostDirectory

 # ftpUpload --
 #
 #       Open ftp session - transfer $local recursively to ftp server - close
 #       ftp session.
 #
 # Arguments:
 #       host     name of ftp server.
 #       user     ftp user name.
 #       passwd   ftp password.
 #       local    name of file or dir.
 #       hostDir  (optional) name of target directory on ftp server.
 #
 # Results:
 #       If $local is a file name the file will be uploaded. If $local is the
 #       name of a local directory, all subdirs and files will be uploaded. 

 proc ftpUpload {host user passwd local {hostDir ""}} {
     set handle [::ftp::Open $host $user $passwd]
     if {$handle < 0} {
         error "Connection refused!"
         return
     }
     ftpGoToDir $handle $hostDir
     foreach l $local {
         recursiveUpload $handle $l $hostDir
     }
     ::ftp::Close $handle
     return
 }

 proc setFtpType {handle fileName} {
     switch -exact -- [file extension $fileName] \
       .txt - .html - .css {::ftp::Type $handle ascii} \
       default {::ftp::Type $handle binary}
 }

 # recursiveUpload --
 #
 #       Recursively transfer directories to ftp server.
 #
 # Arguments:
 #       handle   ftp session handle.
 #       local    name of local file or directory.
 #       hostDir  name of directory on ftp server.
 #
 # Results:
 #       If $local is a file name the file will be uploaded. If $local is the
 #       name of a local directory, all subdirs and files will be uploaded. 

 proc recursiveUpload {handle local hostDir} {
     if {[file isfile $local]} {
         #just a file -> upload
         set fileName [file tail $local]
         setFtpType $handle $fileName
         ::ftp::Put $handle $local [file join $hostDir $fileName]
         return
     } ;# else file is directory -> recursion

     if {![file isdirectory $local]} {return}
     set targetDir [file join $hostDir [file tail $local]]
     ftpGoToDir $handle $targetDir
     # upload regular files of directory
     foreach f [glob -nocomplain -directory $local -type f *] {
         setFtpType $handle [file tail $f]
         ::ftp::Put $handle $f
     }
     # recursion for subdirectories
     foreach d [glob -nocomplain -directory $local -type d *] {
         recursiveUpload $handle $d $targetDir
     }
 }

 # ftpGoToDir --
 #
 #       Change directory on ftp server to given path.
 #
 # Arguments:
 #       handle   ftp session handle.
 #       path     path on ftp server.
 #
 # Results:
 #       Goes to the given path on ftp server. If directories don't exist, they
 #       will be created.

 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
         }
     }
 }

Category Internet