tests/ftpWildcard.tcl

   1 package require TclCurl
   2
   3 proc FtpMatch {pattern filename} {
   4
   5     puts "Pattern: $pattern - File: $filename"
   6
   7     # For this example everything matches
   8     return 0
   9 }
  10
  11 proc FtpCheck {remains} {
  12     global someVar
  13
  14     # Lets forget about directories:
  15     if {($someVar(filetype) eq "directory") || ([regexp {^\.} $someVar(filename)])} {
  16         return 1
  17     }
  18
  19     puts -nonewline "File to download $someVar(filename) ($someVar(size)B) (y/N): "
  20     flush stdout
  21     set line [string tolower [gets stdin]]
  22     if {$line eq y} {
  23         return 0
  24     }
  25     return  1
  26 }
  27
  28 proc FtpSaveFile {readData} {
  29     global   outFile
  30     global   openedFile
  31     global   someVar
  32
  33     if {$openedFile==0} {
  34         if {![file exists downloads]} {
  35             file mkdir downloads
  36         }
  37         set outFile [open "downloads/$someVar(filename)" w+]
  38         fconfigure $outFile -translation binary
  39     }
  40
  41     puts -nonewline $outFile $readData
  42
  43     return 0
  44 }
  45
  46 proc FtpDone {} {
  47     global outFile
  48     global openedFile
  49
  50     puts "Done\n"
  51
  52     close $outFile
  53     set openedFile 0
  54
  55     return 0
  56 }
  57
  58 set openedFile 0
  59 set curlHandle [curl::init]
  60
  61 $curlHandle configure -url ftp://sunsite.rediris.es/sites/metalab.unc.edu/ldp/*
  62 $curlHandle configure -chunkbgnproc  FtpCheck
  63 $curlHandle configure -chunkbgnvar   someVar
  64 $curlHandle configure -chunkendproc  FtpDone
  65 $curlHandle configure -writeproc     FtpSaveFile
  66 $curlHandle configure -wildcardmatch 1
  67 $curlHandle configure -fnmatchproc   FtpMatch
  68
  69 $curlHandle perform
  70
  71 $curlHandle cleanup
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81