一个用FTP批量上传文件的perl脚本，支持目录上传

有时候需要在字符界面下上传文件，尤其是自动上传。

本脚本可以自动判断要上传的是文件还是目录，如果是文件直接上传，如果是目录则递归上传。

自己觉得，写的十分的不优雅，比较Ugly...

代码：

   1   # !/usr/bin/perl -w
   2
   3   #  Procedure Name: ftpupload.pl
   4   #  Author        : Felix New ( felix@hebut.org )
   5   #  Date          : 2007-11-27
   6   #
   7   #  Usage: ftpupload.pl server username password  save_dir {file|dir}
   8   #              where:
   9   #                 server   - name of remote machine
  10   #                 username - ftp username on remote machine
  11   #                 password - password for username on remote machine
  12   #                 save     - save directory / directory, default to user's root
  13   #                 file     - local file for upload
  14   #                 dir      - local dir for upload
  15   #
  16   #  modify:
  17   #  Author        : Felix New (felix@hebut.org)
  18   #  Date          : 2007-12-06
  19   #  Comment       : Add function judge the item is a file or directory,
  20   #                    if the last onw then upload the directory recursivly.
  21
  22
  23   use  strict;
  24   use  Net :: FTP;
  25   use  File :: Basename;
  26   use  File :: Spec :: Functions;
  27
  28  $ |   =   1 ;
  29   my   $prog   =   ' ftpupload.pl ' ;
  30
  31
  32   # #############################
  33   # ##       Main  Start      ###
  34   # #############################
  35
  36   # ## get arguments
  37
  38   if  ( $ # ARGV < 4 )
  39  {
  40       print   " Usage: $prog server username password save_dir {file|directoyr}... " ;
  41       die   " Argument error! " ;
  42  }
  43
  44   my  ( $srv ,   $usr ,   $pwd ,   $remoteDir ,   @files );
  45   $srv   =   shift   @ARGV ;
  46   $usr   =   shift   @ARGV ;
  47   $pwd   =   shift   @ARGV ;
  48   $remoteDir   =   shift   @ARGV ;
  49
  50
  51   # #############################
  52   # ##       Main  Start      ###
  53   # #############################
  54
  55
  56   # ## create ftp and upload file
  57   print   " ftp:   $srv: " ;
  58   print   " ftp directory: $remoteDir " ;
  59   print   " localfiles: @ARGV ############ " ;
  60
  61   my   $ftp   =  new Net :: FTP(  $srv ,  Passive  =>   1 ,  BlockSize  =>   81920 ,  Timeout  =>   300 ,  Debug  =>   0 );
  62
  63   $ftp -> login( $usr ,   $pwd ) or  die   " Can't not login " ,   $ftp -> message ,   " " ;
  64   $ftp -> binary;
  65
  66   & init();
  67
  68
  69   foreach   my   $arg  ( @ARGV )
  70  {
  71       if  ( - d  $arg )
  72      {
  73           & upload( glob   " $arg/* " );
  74      } else
  75      {
  76           & upload( $arg );
  77      }
  78  }
  79
  80   $ftp -> quit();
  81
  82
  83   # #############################
  84   # ##    Main     End        ###
  85   # #############################
  86
  87   sub  upload()
  88  {
  89       foreach   my   $item  ( @_ )
  90      {
  91           next   if  ( $item   =~   /. $ / );
  92           next   if  ( $item   =~   /.. $ / );
  93
  94           next   if   !   $item ;
  95           $item   =~  s //* $ // g;
  96
  97           # ## the director is exists?
  98           my   $basename   =  basename( $item );
  99           my   $dirname   =  dirname( $item );
100
101           if (  - d  $item )
102          {
103               print   " directory: $item " ;
104
105               # ## check the basename exists
106               my   @list = $ftp -> ls();
107               my   $count   =   0 ;
108               while  (  $count   <=  $ # list )
109              {
110                   if  (  $list [ $count ] eq  $basename )
111                  {    # ## exists
112                       last ;
113                  }
114                   $count ++ ;
115              }
116
117               # # the directory is not exists
118               if  ( $count   >  $ # list)
119              {
120                   $ftp -> mkdir ( $basename );
121                   print   " create $basename. " ;
122              }
123               $ftp -> cwd( $basename );
124
125               my   @subitem   =   glob   " $item/* " ;
126               & upload( @subitem );
127               $ftp -> cdup();
128          } else
129          {
130               $ftp -> put( $item ) or ( print   " upload file $item failed " ,   $ftp -> message ,   " "  and  next );
131               print   " $item ok. " ;
132          }
133      }
134  }
135
136   sub  init()
137  {
138       my   $tmpdir   =   $remoteDir ;
139
140       $tmpdir   =~  s //* $ // g;
141
142       while (( my   $offsize   =   index ( $tmpdir ,   ' / ' ))  >   0 )
143      {
144           $tmpdir   =~  s /^/*// g;
145           my   $checkdir   =   substr ( $tmpdir ,   0 ,   $offsize );
146
147           my   @list = $ftp -> ls();
148           my   $count   =   0 ;
149           while  (  $count   <=  $ # list )
150          {
151               if  (  $list [ $count ] eq  $checkdir )
152              {    # ## exists
153                   last ;
154              }
155               $count ++ ;
156          }
157
158           # # the directory is not exists
159           if  ( $count   >  $ # list)
160          {
161               $ftp -> mkdir ( $checkdir );
162               print   " create $checkdir. " ;
163          }
164           $ftp -> cwd( $checkdir );
165           $tmpdir   =   substr ( $tmpdir ,   $offsize   +   1 );
166      }
167
168       if ( $tmpdir )
169      {
170           my   @list = $ftp -> ls();
171           my   $count   =   0 ;
172           while  (  $count   <=  $ # list )
173          {
174               if  (  $list [ $count ] eq  $tmpdir )
175              {    # ## exists
176                   last ;
177              }
178               $count ++ ;
179          }
180
181           # # the directory is not exists
182           if  ( $count   >  $ # list)
183          {
184               $ftp -> mkdir ( $tmpdir );
185               print   " create $tmpdir. " ;
186          }
187           $ftp -> cwd( $tmpdir );
188      } else
189      {
190           # ## if $remoteDir is '/'
191           $ftp -> cwd( $remoteDir )  if   !   $tmpdir ;
192      }
193  }