Listing 5: mirror_put

#!/usr/bin/perl -w
# Transfers local file tree to the remote machine.
#     usage: mirror_put [-d -D] host localdir remotedir name password
#        -d  Debug mode - don't actually transfer anything.
#        -D  Turn on Net::FTP debug messages
# NOTES
#    remotedir must already exist on the remote server

use Getopt::Std;
use Net::FTP;
use Cwd;

getopts("dD");
defined($opt_d) or $opt_d = 0;
defined($opt_D) or $opt_D = 0;

my $host      = shift;
my $localdir  = shift;
my $remotedir = shift;
my $name      = shift;
my $password  = shift;

defined($host)        and 
  defined($localdir)  and 
  defined($remotedir) and 
  defined($name)      and 
  defined($password)  or 
  die "usage: $0 [-D] host localdir remotedir name password";

$ftp = Net::FTP->new($host, Debug => $opt_D ? 1 : 0)
    or die "ERROR: Net::FTP->new() failed\n"; 
$ftp->login($name, $password) or die "ERROR: login() failed\n";
$ftp->binary;     # Assume binary transfers.

# Go to the starting point in the local tree.
chdir($localdir) or die "ERROR: can't cwd() to $localdir\n";  

# Go to the starting point in the remote tree.
$ftp->cwd($remotedir) or die "ERROR: can't cwd() to $remotedir\n";  

# Keep track of directory path as separate elements to 
# facilitate mirroring of directory paths on remote system.
my @path;

finddepth_gl(\&process_item, 1);    # Crawl over the local tree

$ftp->quit;

sub process_item {
    my ($level, $isdir, $item, $parent) = @_;
    foreach (1..$level) { print "   " }
    if ($isdir) {
        print "DIRECTORY: ",$parent,$item,"\n";
        $ftp->mkdir($parent.$item) or die "ERROR: can't mkdir ",$parent,$item,"\n";
    } else {
        print "FILE: ",$item,"\n";
        my $save_remote = $ftp->pwd;
        $ftp->cwd($parent) or die "ERROR: can't cwd() to $parent\n";  
        $ftp->put($item);
        $ftp->cwd($save_remote) or die "ERROR: can't cwd() to $save_remote\n";
    }    
}

sub finddepth_gl {
    my ($callback, $level) = @_;

    # Make a listing of files and/or directories.
    my $cwd = cwd;
    opendir(DIR, $cwd) or die "ERROR: can't opendir() on $cwd: $!\n";
    
    my ($item, @list);
    while (defined($item = readdir(DIR))) { push(@list, $item)}
    closedir(DIR);   
    
    foreach $item (@list) {
        next if $item =~ /\.\.?$/;
        my $parent = "";
        my $i;
        foreach $i (@path) { ($parent .= $i."/" }
        if ( -d $item) {
            # It's a directory — call the callback.
            &$callback($level, 1, $item, $parent);
            
            # Recursively crawl the subtree under this directory.
            push(@path, $item);
            my $save_local = cwd;
            chdir($item) or die "ERROR: can't chdir() to $item\n";
            finddepth_gl($callback, $level+1);

            # Restore location in local tree.
            chdir($save_local) or die "ERROR: can't chdir() to $save_local\n";
            pop(@path);
        } elsif ( -f $item) {
            # It's a file - call the callback.
            &$callback($level, 0, $item, $parent);
        }
    }
}