#!/usr/bin/perl -w
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use IO::File;
use File::Find;
use File::Copy;
use IPC::Open3;

#############
#Global Vars#
#############
my $root_dir;
my $conf_dir;
my $log_dir;
my $conf_file = 'archiver.conf';

#Debugging is on a 0 - 4 scale (ie FATAL - DEBUG) We stick to warn. Everything below is shown.
my %debug = (
    'FATAL' => 0,
    'ERROR' => 1,
    'WARN'  => 2,
    'INFO'  => 3,
    'DEBUG' => 4,
);
my $debug_level = $debug{'WARN'};

##########################
##Program Initialization##
##########################

#Find out what options have been called
my $verbose_opt = 0;
my $quiet_opt   = 0;
my $check_opt;
my $help_opt;
my $config_opt;
my $ezdir_opt;

#Enable bundling and pull the command line opts
Getopt::Long::Configure('bundling');
GetOptions(
    'help|h'     => \$help_opt,
    'verbose|v+' => \$verbose_opt,
    'quiet|q+'   => \$quiet_opt,
    'check|k'    => \$check_opt,
    'config|c=s' => \$config_opt,
    'ezdir|e=s'  => \$ezdir_opt
);

#Setup the debugging level (should range from 0 - 4)
$debug_level = $debug_level + $verbose_opt - $quiet_opt;

#Source the navycash profile and copy the ENV vars into the current environment
my ( *KSH_WTR, *KSH_RDR, *KSH_ERR );
my $ksh_pid =
  open3( *KSH_WTR, *KSH_RDR, *KSH_ERR, '/bin/ksh',
    '-c ". /usr/local/profiles/profile.navycash; set"' );
close KSH_WTR;
close KSH_ERR;
while (<KSH_RDR>) {
    if (/=/mx) {
        my ( $k, $v ) = split /=/mx, $_, 2;
        logger( "ENV var $k is $v", $debug{'DEBUG'} );
        $ENV{$k} = $v;
    }
}
close KSH_RDR;
waitpid $ksh_pid, 0;

#Help Screen (Exits the program)
if ($help_opt) {
    pod2usage(1);
}

#Set up the directories and files
if ($ezdir_opt) {
    $root_dir = $ezdir_opt;
}
elsif ( $ENV{'EZ_DIR'} ) {
    $root_dir = $ENV{'EZ_DIR'};
}
else {
    logger( 'EZ_DIR is not set. Please pass the dir as an arguement.',
        $debug{'FATAL'} );
}
$conf_dir = $root_dir . '/conf';
$log_dir  = $root_dir . '/log';
if ($config_opt) {
    $conf_file = $config_opt;
}
else {
    $conf_file = "$conf_dir/$conf_file";
    logger( "Config file is $conf_file", $debug{'DEBUG'} );
}

#Check Configuration File, Exits with a 0 status
#when finished, follows UNIX rule of silence
if ($check_opt) {
    check_conf_file($conf_file);
    exit 0;
}

#Run the main program
logger( 'Starting the file move.', $debug{'WARN'} );
my @file_groups = read_config_file($conf_file);
my $total_moved = 0;
foreach my $group (@file_groups) {
    $total_moved += find_move_matches($group);
}
logger( "Finished Moving $total_moved files.", $debug{'WARN'} );

#########################
###Program Subroutines###
#########################

#Parses the config file to ensure it is written correctly.
sub check_conf_file {
    my $config_file = shift;
    if ( !-r $config_file ) {
        logger( 'Cannot read the configuration file ' . $config_file,
            $debug{'FATAL'} );
    }
    my $config_fh = IO::File->new( $config_file, 'r' );
    while ( my $line = <$config_fh> ) {
        if ( $line =~ /^[#]/mx or $line =~ /^[\s]+/mx )
        {    #Comment and Empty Lines
            next;
        }
        chomp $line;
        if (
            $line =~ /
              ([\S]+)   #Source Dir
              [\s]*
              ([\S]+)	  #Archive Dir
              [\s]*
              ([\S]+)	  #Filter (can be a perl regex)
              [\s]*
              /mx
          )
        {
            if ( ( not -d $1 ) and ( not -r $1 ) ) {
                logger( "The $1 directory in $line is not valid and readable.",
                    $debug{'FATAL'} );
            }
            if ( ( not -d $2 ) and ( not -w $2 ) ) {
                logger( "The $2 directory in $line is not valid and writeable.",
                    $debug{'FATAL'} );
            }
        }
        else {
            logger( "The config file is broken due to: $line",
                $debug{'FATAL'} );
        }
    }
    return;
}

#Returns the current date as a scalar
sub current_date {
    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
      localtime;
    return ( sprintf '%.2x', ( $year - 100 ) )
      . ( sprintf '%.2x', ( $mon + 1 ) )
      . ( sprintf '%.2x', $mday );
}

#Finds all files that meet the file group's criteria
#Immediately moves the files it finds so it scales better
sub find_move_matches {
    my $fgroup      = shift;
    my $filter      = $fgroup->{'filter'};
    my $total_moved = 0;
    find(
        sub {
            if (/$filter/mx) {
                logger( 'File found ' . $File::Find::name, $debug{'DEBUG'} );
                move_file( $File::Find::name, $fgroup->{'dest'} . "/$_" );
                $total_moved++;
            }
        },
        $fgroup->{'source'}
    );
    return $total_moved;
}

#Logs output to the proper log file based on the $debug flag
#Warning any FATAL messages with cause the program to die and log to STDERR
sub logger {
    my ( $message, $level ) = @_;
    my %debug_names = reverse %debug;
    my $log_mesg =
      localtime() . ' -- ' . $debug_names{$level} . ' -- ' . $message;
    if ( $level <= $debug_level )
    {    #Only do the logging if the debug level is correct
        if ( $level == $debug{'FATAL'} ) {
            die $log_mesg;
        }
        my $logfh =
          IO::File->new( $log_dir . '/archiver-' . current_date(), 'a' );
        print {$logfh} "$log_mesg\n";
        $logfh->close;
    }
    return;
}

#Actually performs the file move
sub move_file {
    my $srcf = shift;
    my $desf = shift;

    if ( move( $srcf, $desf ) ) {
        logger( "Moved $srcf to $desf", $debug{'INFO'} );
    }
    else {
        logger( "Failed to move $srcf to $desf", $debug{'WARN'} );
    }
    return;
}

#This reads in the config file and spits back the file groups to process
#It tries to accept anything, and make the best of it
sub read_config_file {
    my $config_file = shift;
    my $config_fh = IO::File->new( $config_file, 'r' );

    my @file_groups;
    while ( my $line = <$config_fh> ) {
        if ( $line =~ /^[#]/mx or $line =~ /^[\s]+/mx )
        {    #Comment and Empty Lines
            next;
        }
        chomp $line;
        if (
            $line =~ /
              ([\S]+)   #Source Dir
              [\s]*
              ([\S]+)	  #Archive Dir
              [\s]*
              ([\S]+)	  #Filter (can be a perl regex
              [\s]*
              /mx
          )
        {
            push @file_groups,
              {
                source => $1,
                dest   => $2,
                filter => $3,
              };
            logger( "Using $1 $2 $3", $debug{'DEBUG'} );
        }
        else {
            logger( "Bad File Group $line Check your config file.",
                $debug{'ERROR'} );

        }
    }
    return @file_groups;
}

__END__

=head1 NAME

archiver - Generic file mover program.

=head1 SYNOPSIS

 archiver [options]

=head1 OPTIONS

=over 8

=item -h or --help		
	Prints a brief help message and exits.

=item -v or --verbose
	Produces increasing amounts of log output
	(ie -v -vv)

=item -k or --check
	Check the config file syntax

=item -c or --config FOO
	Points at a different config file

=item -q or --quiet
	Produces decreasing amounts of log output
	(ie -q -qq -qqq)

=item -e or --ezdir FOO
	Sets the base directory to a different location

=back

=head1 DESCRIPTION

 This script is designed to move files from a source directory to an archive directory as specified by a configuration file.

=head1 AUTHOR

 Christopher Hotchkiss <christopher.a.hotchkiss@jpmchase.com>

=cut