Hello, I'm trying to FTP backup a large amount of data from one server to another. The code below almost works except for the chdir().

What I like about this code:

  • It opens $MAXTHREADS + 1 FTP connections and then re-uses them
  • The main thread fills the queue while the workers FTP the files

    • The base code I found here: http://www.perlmonks.org/?node_id=735923. I've tried to find/figure out how to do the same thing with fork() but, so far have been unsuccessful.

    My question is: Is there a way to convert this program to use fork().

    #! /usr/bin/perl -slw
use strict;
use warnings;
use threads;
use Thread::Queue;
use Net::FTP;
use Cwd;

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(t
+ime);
$year = $year + 1900;
$mon = $mon + 1;

my $today = sprintf ("%d-%02d-%02d", $year, $mon, $mday);
# print $today . "\n";

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time
+-604800);
$year = $year + 1900;
$mon = $mon + 1;

my ($gFtp, $gResponseCode, $gServer, $gFtpServer, $gFtpUser, $gFtpPass
+, $gDirs, $gCnt);
my ($gPs);
my (@gDirectories);

# change these to your environment
$gServer = "LOCALSERFVER";
our $MAXTHREADS = 10;
$gFtpServer = "FTPSERVER";
$gFtpUser = "FTPUSER";
$gFtpPass = "FTPPASS";
$gDirs = "/var/www/html,/home"; # comma seperated list of dirs to back
+ up.

@gDirectories = split (",", $gDirs);

&connectFTP();

$gFtp->mkdir($today);
$gFtp->cwd($today);

sub worker {
   my $tid = threads->tid;
   my( $Qwork, $Qresults ) = @_;

   my ($running, $check, $process);

   my $ftp = Net::FTP->new($gFtpServer, Debug => 0);
   $ftp->login($gFtpUser, $gFtpPass) or print "unable to login to $gFt
+pServer: $ftp->message\n";

   while(my $work = $Qwork->dequeue) {
      my $result;
      my @workItem;

      @workItem = split (",", $work);

      chomp($workItem[0]);
      chomp($workItem[1]);
      chomp($workItem[2]);
      print "ftp dir: $workItem[0]\n";
      print "local dir: $workItem[1]\n";
      print "file: $workItem[2]\n";

      chdir($workItem[1]) or print "unable to open $workItem[2]\n";
      $ftp->cwd($workItem[0]) or print "unable to FTP change dir $work
+Item[0]: $ftp->message\n";
      $ftp->put($workItem[2]) or print "unable to FTP $workItem[2]: $f
+tp->message\n";
      ## Process $work to produce $result ##
      $result = "$tid : result for workitem ";
      $Qresults->enqueue( $result );
   }
   $Qresults->enqueue( undef ); ## Signal this thread is finished
   $ftp->quit;
}

my $Qwork = new Thread::Queue;
my $Qresults = new Thread::Queue;

## Create the pool of workers
my @pool = map{
   threads->create( \&worker, $Qwork, $Qresults )
} 1 .. $MAXTHREADS;

## Get the work items (from somewhere)
## and queue them up for the workers
$gCnt = 0;
while(defined($gDirectories[$gCnt])) {
   my ($lCnt, $lNumDirs);
   my (@lDirectory);

   @lDirectory = split ("/", $gDirectories[$gCnt]);
   $lNumDirs = scalar(grep {defined $_} @lDirectory);
   print "num dirs: $lNumDirs\n";
   $lCnt = 0;
   while (defined($lDirectory[$lCnt])) {
      chomp($lDirectory[$lCnt]);
      if ($lCnt == 0) {
         print $lDirectory[$lCnt]." $lCnt";
         chdir('/');
      } elsif ($lCnt == ($lNumDirs - 1)) {
         print $lDirectory[$lCnt]." $lCnt";
         &scanDirectory($lDirectory[$lCnt]);
      } else {
         print $lDirectory[$lCnt]." $lCnt";
         $gFtp->mkdir($lDirectory[$lCnt]);
         $gFtp->cwd($lDirectory[$lCnt]);
         chdir($lDirectory[$lCnt]);

         print "creating Dir $lDirectory[$lCnt]\n";
         my $temp = &cwd;
         print $temp."\n";
      }
      $lCnt++;
   }

   $gCnt++;
}

$gFtp->quit();

## Tell the workers there are no more work items
$Qwork->enqueue( (undef) x $MAXTHREADS );

## Process the results as they become available
## until all the workers say they are finished.
for ( 1 .. $MAXTHREADS ) {
   while( my $result = $Qresults->dequeue ) {

       ## Do something with the result ##
       print $result;
   }
}

## Clean up the threads
$_->join for @pool;


sub scanDirectory {
   my ($workdir) = @_;

   my ($startdir, $ftpStartDir, $name, $ftpCurrentDir, $workItem);
   my (@names);


   $startdir = &cwd;    # keep track of where we began
   $ftpStartDir = $gFtp->pwd();

   # print "workdir " . $workdir . "\n";
   # print "startdir " . $startdir . "\n";
   # print "ftpStartDir " . $ftpStartDir . "\n";

   # print "ftp mkdir " . $workdir . "\n";
   $gFtp->mkdir($workdir, 0);
   # print "ftp cd1 " . $workdir . "\n";
   $gFtp->cwd($workdir);
   $ftpCurrentDir = $gFtp->pwd();
   # print "ftpCurrentDir ".$ftpCurrentDir."\n";

   chdir($workdir) or die "Unable to enter dir $workdir:$!\n";
   opendir(DIR, ".") or die "Unable to open $workdir:$!\n";
   @names = readdir(DIR) or die "Unable to read $workdir:$!\n";
   closedir(DIR);

   foreach $name (@names){
      next if ($name eq "."); 
      next if ($name eq "..");

      # is this a directory?
      if (-d $name){
         &scanDirectory($name);
         next;
      } else {
         # print "ftp " . $name . "\n";
         # print $startdir."/".$workdir."/".$name . "\n";
         #print $ftpCurrentDir."\n";

         $workItem = sprintf("%s,%s/%s/,%s",$ftpCurrentDir,$startdir,$
+workdir,$name);

         #print $workItem."\n";

         $Qwork->enqueue($workItem);

      }
   }
   # print "ftp cd2 " . $ftpStartDir . "\n";
   $gFtp->cwd($ftpStartDir);
   chdir($startdir) or
      print "Unable to change to dir $startdir:$!\n";
}

sub connectFTP {
   $gFtp = Net::FTP->new($gFtpServer, Debug => 0);
   if (!$gFtp) {
      $gResponseCode = sprintf ("Cannot connect to $gFtpServer: $@");
      print $gResponseCode . "\n";
      return 0;
   }
   if (!$gFtp->login($gFtpUser, $gFtpPass)) {
      $gResponseCode = sprintf ("Cannot login to $gFtpServer: %s", $gF
+tp->message);
      print $gResponseCode . "\n";
      return 0;
   }
   return 1;
}

    [download]

    In reply to Threaded or Forked FTP Backup with chdir by Mimir

    Title:
    Use:  <p> text here (a paragraph) </p>
    and:  <code> code here </code>
    to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.