#!/usr/bin/perl -w

###############################################################################
#
# To view the full documentation please run this program with the "--manual" 
# option.
#
# This program derives some content from several separate Perl scripts found 
# on the web, since on their own none of them did quite what I wanted.
#
# I have lost the URLs so I regret I can't properly attribute any 
# contributing authors.
#
#                                           Chris Gillings - 2007-12
#
###############################################################################

use Net::FTP;
use File::Listing qw(parse_dir);
use Getopt::Long;
use Pod::Usage;

sub options () {
	my $help = 1;		# handled locally
	my $ident = 0;		# handled locally
	my $man = 0;		# handled locally

	# Process options.
	if ( @ARGV > 0 ) {
            $help = 0;
            GetOptions (
               'server=s'   => \$server, 
               'username=s' => \$username,
               'password=s' => \$password,
               'verbose'    => \$verbose,
               'debug'      => \$debug,
               'lowercase'  => \$lowercase,
               'clean'      => \$clean,
               'replace=s'  => \$replacechar,
               'bugfix'     => \$bugfix,
	       'help|?'	    => \$help,
	       'manual'	    => \$man,
               'go'         => \$proceed)
	      or pod2usage(2);
	}
	if ( $man or $help ) {
	    # Load Pod::Usage only if needed.
	    require "Pod/Usage.pm";
	    import Pod::Usage;
	    pod2usage(1) if $help;
	    pod2usage(VERBOSE => 2) if $man;
	}
}

sub doRecurse
{
    # directory parameter passed to the sub-routine
    my $dir = $_[0];
  
    # change to the remote directory
    $ftp->cwd($dir) if($dir);
    warn "\nFTP: cwd $dir\n" if $debug;

    # get the path of the current working directory on the remote server
    my $cur_dir = $ftp->pwd();
    warn "FTP: pwd = $cur_dir\n" if $debug;

    # if the cwd command failed, do not continue 
    warn "FTP: Failed to cwd to \"$dir\"\n" 
          if ( $debug && ( $cur_dir ne $dir ));
    return if ( $cur_dir ne $dir );
  
    # get the directory file listing
    if ( $bugfix ) {
       # proftpd seems to produce no output for 'ls'
       @ls = $ftp->dir() or warn $ftp->message;
    } else {
       @ls = $ftp->ls('-l') or warn $ftp->message;
    }

    # parse and loop through the directory listing
    foreach my $file (parse_dir(\@ls)) 
    {
       # extract useful info from file listing (we only need the name)
       my($name, $type, $size, $mtime, $mode) = @$file; 

       next if($name eq "."); # do nothing with the current directory
       next if($name eq ".."); # or the parent

       my $newname = $name;

       # convert filename to lowercase
       $newname =~ tr/[A-Z]/[a-z]/ if $lowercase; 

       # do a full character clean?
       $newname =~ s/[^$OK_CHARS]/$replacechar/go if $clean;

       # show the user the new filename
       print "$cur_dir/$newname\n" if $verbose;

       # rename file only if such is needed and wanted
       if (($name ne $newname) && $proceed) {
          warn "FTP in $cur_dir: rename $name $newname\n" if $debug;
          #$ftp->rename($name,$newname) or warn "Failed to rename $name $@\n";
          $ftp->rename($name,$newname) or warn $ftp->message;
          $name = $newname;
       }
  
       # skip recurse if current file is not a directory
       next if($type ne 'd');
  
       # do recursive call to get the entries in this file directory
       doRecurse ("$cur_dir/$name");
       warn "\n" if $debug;

       # the FTP connection doesn't know we've changed directories
       $ftp->cwd($cur_dir);
    }
}

# begin main

local $ftp;
local $OK_CHARS='-a-zA-Z0-9_.';
local $clean=0, $lowercase=0, $verbose=0, $bugfix=0; 
local $proceed=0, $replacechar="_", $debug=0;
local $server="";
local $username="";
local $password="";
local $rootdir="";

  options();
  $rootdir = $ARGV[0];

  if ($server eq "")   { warn "Server not defined\n"; exit; }
  if ($username eq "") { warn "Username not defined\n"; exit; }
  if ($password eq "") { warn "Password not defined\n"; exit; }
  if ($rootdir eq "")  { warn "Directory not defined\n"; exit; }

  if ( $debug ) {
               print "Command line: ";
               print "-server=$server ";
               print "-username=$username ";
               print "-password=$password ";
               print "-verbose " if $verbose;
               print "-debug " if $debug;
               print "-lowercase " if $lowercase; 
               print "-clean " if $clean;
               print "-replace=$replacechar ";
               print "-go " if $proceed;
               print "\n";
  }

  # Create the FTP object
  if (!defined($ftp)) {
    warn "Creating FTP connection to <$server>\n" if $debug;
    $ftp = Net::FTP->new($server) if (!defined($ftp));

    # Very bad if still not defined
    if (!defined($ftp)) {
      warn "$program: can't create FTP object: $@\n";
      return(1);
    }

    # Log into the remote host
    warn "Logging in using login = <$username>, ", 
         "password = <$password>\n" if $debug;
    if ($ftp->login($username, $password) == 0) {
        warn "$program: can't login to <$server>\n";
      return(1);
    }
  }

doRecurse ($rootdir);
  
# close the FTP connection
$ftp->quit();

__END__

=head1 NAME

recurseftp.pl - Perform simple file renaming operations recursively in 
an FTP directory tree

=head1 SYNOPSIS

perl recurseftp.pl [options] required_arguments

Required arguments:

	-server	NAME	FTP Server
	-username NAME	Login Username
	-password NAME	Login password
	NAME		Parent directory

Options:

	-lowercase 	Convert filenames to lowercase
	-clean		Clean bad characters from filenames
	-replace CHAR	Choose character to replace bad characters
	-go		Proceed with renaming operation
	-verbose	Verbose reporting on renaming
	-debug		Report on detailed activity
	-help		Prints the help and exits
	-man		Prints the manual and exits

=head1 ARGUMENTS

=over 8

=item B<-s,--server NAME>

Name or IP of FTP server to connect to

=item B<-u,-username NAME>

Username for logging in to FTP server

=item B<-p,-password NAME>

Password for login to FTP server 

=item B<directory>

The parent directory for the FTP tree you want to operate on.

=head1 OPTIONS

=item B<-l,-lowercase>

Convert characters in filenames to lowercase and rename

=item B<-c,-clean>

Replace characters not normally used in Unix filenames and rename 

=item B<-r,-replace CHAR>

Select character to replace bad characters (default is "_")

=item B<-g,-go>

Proceed ("B<go>" ahead) with renaming; this guards against accidents

B<N.B. If you do not include this option, no files will be renamed!>

=item B<-v,-verbose>

List all files as they would be renamed

=item B<-d,-debug>

Report on FTP transactions and other activity; this can help you figure 
it out when things seem to be going wrong

=item B<-b,-bugfix>

Some FTP servers produce no output for the "ls" command used by this program
but the "dir" command does.  If you get no file listings when running this
program try again using this option. It has the harmless side-effect of occasionally
emitting the messages 

   Opening ASCII mode data connection for file list
   Transfer complete.

=item B<--help, --?>

Prints a help message and exits.

=item B<--man>

Prints the manual and exits.

=head1 DESCRIPTION

This program performs basic filename renaming on all files on an FTP 
server below a specified directory.  Options are to lowercase all 
filenames and/or to clean out and replace characters not normally 
considered acceptable in Unix filenames.

If neither lowercasing nor cleaning is requested the program does 
no renaming at all; if B<verbose> is selected in this instance it 
allows you to get a simple listing of files from the server.

It may be of help to know that the program recurses the directory tree 
"depth-first". That is, it descends down each sub-directory as it 
encounters it in the file listing of the parent.

=head1 EXAMPLES

Convert all files to lowercase below the directory "/docs/new" owned 
by fred28 on FTP server ftpserver.example.com.

  perl recurseftp.pl -server ftpserver.example.com -u fred28 -p itsasecret -lowercase -go /docs/new

Clean all bad characters from all files in the entire FTP server tree 
owned by Sarah.

  perl recurseftp.pl -s sarah.example.com -u sarah -p teddybear -clean -g /

List all files below CharlieE<apos>s "/guest" directory

  perl recurseftp.pl -s ftp.example.net -u charlie -p itsme -v /guest

=head1 AUTHOR

Chris Gillings <chris@gillings.com.au>

=head1 DISCLAIMER & UNWARRANTY

This program is not warranted to work faultlessly or precisely as 
described and the author assumes no responsibility whatsoever for any 
damage done to your files if it fails to perform its intended job. 
This program has been successfully tested on Unix (using standard 
Perl 5.8) and Windows platforms (using ActivePerl 5.8).

=head1 COPYRIGHT AND LICENSE

Copyright 2008 by Chris Gillings

This program is free software; you can redistribute it and/or modify 
it under the terms of the GNU General Public License (version 2 or any 
later version).

=cut