#!/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