WJG 2005-11-23: 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-04-05: Is there a reason Tk is required for this?
Pierre Coueffin 2006-04-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-03-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 } } }
tonytraductor - Likely this is extremely inefficient, and there are better ways to do it, but, I wrote one that uploads, and downloads. I don't like my method of listing and finding a remote file to download, but, with my very n00bish skills, it was what I could figure out to make it work. Also, this one will offer the user to open an uploaded file in the browser of their choice (provided it is a file a browser can open, such as .txt, .html, .jpg, etc.), and tells the user where the URL is for an uploaded file, and the location of a downloaded file. It was fun...I'll keep learning.
#!/usr/bin/env wish8.5 # This program was written by tony baldwin - [email protected] # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA # tclUP copyright tony baldwin - [email protected] # load necessary packages package require ftp ####### #global vars...I'm always getting hollered at for these, but, they're working for me. ####### global filename global rfile global fname global host global path global username global password global url global dlay global file_types global list global dldir #### # File types I most frequently up/download from my server, anyway #### set file_types { {"All Files" * } {"Text Files" { .txt .TXT}} {"LaTex" {.tex}} {"PDF" {.pdf}} {"Xml" {.xml}} {"Html" {.html}} {"CSS" {.css}} {"Image" {.jpg .jpeg .gif .png}} {"Zipped" {.gz .zip .rar}} {"Music" {.ogg .mp3 .wav .wma}} {"Video" {.mpg .mov .avi .wmv}} } wm title . "TickleUP" ######## # gui ######## frame .notes grid [ttk::label .notes.lab -text "Server information:"] pack .notes -in . -fill x frame .fields grid [ttk::label .fields.hq -text "Host:"]\ [ttk::entry .fields.host -textvariable host]\ [ttk::label .fields.pathq -text "Directory: "]\ [ttk::entry .fields.path -textvariable path] grid [ttk::label .fields.unam -text "Username: "]\ [ttk::entry .fields.uname -textvariable username]\ [ttk::label .fields.pwrd -text "Password: "]\ [ttk::entry .pswrd -show * -textvariable password] pack .fields -in . -fill x frame .ubtns grid [ttk::label .ubtns.lbl -text "Uploads:"] grid [ttk::button .ubtns.filename -text "Local file" -command grabfile]\ [ttk::button .ubtns.send -text "Upload" -command {upload}] pack .ubtns -in . -fill x frame .dbtns grid [ttk::label .dbtns.lbl -text "Downloads:"] grid [ttk::button .dbtns.dlfilen -text "List" -command {dlist}]\ [ttk::entry .dbtns.file -textvariable rfile]\ [ttk::button .dbtns.ddn -text "Download" -command {down}] pack .dbtns -in . -fill x frame .btns grid [ttk::button .btns.out -text "QUIT" -command {exit}] pack .btns -in . -fill x ######### # procs ######### ###### # My really lame, n00bish means of listing the files on the remote server ###### proc dlist {} { set handle [::ftp::Open $::host $::username $::password] set list [::ftp::NList $handle $::path] toplevel .list wm title .list "Remote File List" text .list.l -width 80 -height 40 -wrap word .list.l insert end "$list" .list.l insert end "\n \n Copy the file name you wish to download and paste to the entry field.\n Then click \'download\' and choose the directory where to save it." pack .list.l -in .list -fill x } ##### # dls the file, tells you where it is ##### proc down {} { global dldir set dldir [tk_chooseDirectory] set handle [::ftp::Open $::host $::username $::password] ::ftp::Cd $handle $::path ::ftp::Get $handle $::rfile $::dldir/$::rfile ::ftp::Close $handle toplevel .down wm title .down "Success!" tk::message .down.loaded -text "Your file has been downloaded to $::dldir/$::rfile" tk::button .down.out -text "Okay" -command {destroy .down} pack .down.loaded -in .down -side top pack .down.out -in .down -side top } ##### # uploads the file, tells you where it is, offers to open it in a browser for verification ##### proc upload {} { global fname set fname [file tail $::filename] set handle [::ftp::Open $::host $::username $::password] ::ftp::Cd $handle $::path ::ftp::Put $handle $::filename $::fname ::ftp::Close $handle toplevel .url grid [ttk::label .url.lbl -text "Your image is at\n http:://www.$::host/$::path/$::fname"] grid [ttk::button .url.btn -text "open in browser" -command {browse}]\ [ttk::button .url.not -text "close" -command {destroy .url}] } ##### # grabs the local file to upload # I wish I could use a tk_getOpenFile to grab the remote file # like this, but, I couldn't get a tk_getOpenFile to open at # the remote server location, which I tried with # set $odir [::ftp::Cd $handle $::path] # set filename [tk_getOpenFile -filetypes $::file_types -initialdir $odir] # but that didn't work... ##### proc grabfile {} { global filename set filename [tk_getOpenFile -filetypes $::file_types] wm title . "Now Tickling: $::filename" } ##### #proc to view an uploaded remote file with a browser # whoopee ##### proc browse {} { set filetypes " " tk_messageBox -message "Choose your browser" -type ok -title "Set browser" set brow [tk_getOpenFile -filetypes $filetypes] # I just end up typing in /usr/bin/konqueror or something rather than surf # the file system for it exec $brow www.$::host/$::path/$::fname & }