ScriptUtil - Object Orientated class to make typical command line scripts easier to write

 use ScriptUtil;
 # All of these parameters are optional:
 my $script = ScriptUtil->new(
    'verbose'               => 1,            # Output messages to STDOUT
    'nolog'                 => 1,            # Disable logging
    'nolock'                => 1,            # Disable script locking
    'log_debug'             => 5             # Debug level for logging
    'log_filename'          => 'foo.log',    # Log file name
    'log_path'              => '/tmp',       # Location of log files
    'log_mode'              => '>>',         # Log file mode
    'log_stderrredirect'    => 0,            # Redirect stderr into log
    'log_storeexptext'      => 1,            # Log store internally all exp text
    'log_datetimestamp'     => 1,            # Timestamp log data entries
    'log_logfiledatetime'   => 1,            # Timestamp the log file name
    'log_rotation'          => 1,            # Do log rotation if logging is enabled
    'log_zip_after_days'    => 2,            # Zip log files older than X days if log_rotation is enabled
    'log_rm_after_days'     => 5,            # Delete log files older than X days if log_rotation is enabled
 );

 # Put a message into the log file unless the 'nolog' flag has been set
 # Also print to STDOUT if the verbose flag has been set

 $script->echo("Boo");

 # Put a message into the log file unless the 'nolog' flag has been set
 # And 'log_debug' is greater than or equal to 10

 $script->echo("Boo", 10);

 use ScriptUtil;

 my $script = ScriptUtil->new(
                              verbose       => 1,
                              log_path      => '/var/logs/foo',
                              log_rotation  => 1,
                              log_debug     => 1,
                              );

 $script->echo("Cleaning up a string", 1);

 my $string = "\t Foo Bar              \t\t    \n\n\n";
 $script->echo("String Before Cleanup: [" . $string . "]", 10); # log_debug = 1 so you won't see this

 $string = $script->trim($string);
 $script->echo("String After Cleanup: [" . $string . "]"); # uses default debug level you will see this

 $script->verbose(0);
 $script->echo("You will only see this message in the log file", 1);

 # Usage:
 echo(STRING message, INTEGER debug level)

 # Examples:
 $script->echo("This is a message");
 $script->echo("This is a message with a debug level", 10);

 # Usage:
 STRING = trim(STRING text)

 # Example:
 my $trimmed_string = $script->trim("\t  \t This is a string that needs trimming    ");

 0.02

package ScriptUtil;

use 5.008008;
use strict;
use warnings;
use Cwd;
use Fcntl qw(:flock);
use Benchmark;
use File::Log;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use File::Spec;
use Carp qw(carp confess);
use Moose;
use File::Basename;

our $VERSION   = '0.02';

extends 'Moose::Object';

################################################################################
# Object Attributes:
################################################################################
has 'verbose'               => ( isa => 'Bool', is => 'rw', required => 0, default => 0 );
has 'nolog'                 => ( isa => 'Bool', is => 'rw', required => 0, default => 0 );
has 'nolock'                => ( isa => 'Bool', is => 'rw', required => 0, default => 0 );
has '_parent'               => ( isa => 'Str', is => 'rw', required => 0, default => undef );
has '_bench_start'          => ( isa => 'Benchmark', is => 'rw', required => 0 );
has '_bench_end'            => ( isa => 'Benchmark', is => 'rw', required => 0 );
has '_self_fh'              => ( isa => 'Any', is => 'rw', required => 0, default => undef );
has 'log_debug'             => ( isa => 'Int', is => 'ro', required => 0, default => 5 );
has 'log_path'              => ( isa => 'Str', is => 'rw', required => 0, default => '.' );
has 'log_filename'          => ( isa => 'Str', is => 'rw', required => 0, default => undef );
has 'log_mode'              => ( isa => 'Str', is => 'ro', required => 0, default => '>>' );
has 'log_stderrredirect'    => ( isa => 'Bool', is => 'ro', required => 0, default => 0 );
has 'log_storeexptext'      => ( isa => 'Bool', is => 'ro', required => 0, default => 1 );
has 'log_datetimestamp'     => ( isa => 'Bool', is => 'ro', required => 0, default => 1 );
has 'log_logfiledatetime'   => ( isa => 'Bool', is => 'rw', required => 0, default => 1 );
has 'logger'                => ( isa => 'File::Log', is => 'rw', required => 0, default => undef );
has 'log_rotation'          => ( isa => 'Bool', is => 'ro', required => 0, default => 0 );
has 'log_zip_after_days'    => ( isa => 'Num', is => 'ro', required => 0, default => 2 );
has 'log_rm_after_days'     => ( isa => 'Num', is => 'ro', required => 0, default => 31 );
has '_log_pattern'          => ( isa => 'Str', is => 'ro', required => 0, default => '.log' );

################################################################################
# Methods
################################################################################
# Constructor:
################################################################################
sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    
    # Begin benchmark timing:
    $self->_bench_start(new Benchmark);

    # Get the details of the script using this module:
    my ($package, $parent, $line) = caller;
    $self->_parent($parent);
    
    # Lock ourself, so we only run one process at a time:
    unless ($self->nolock) {
        $self->locker();
    }
    
    # Set up logging if required:
    my $logger = undef;
    unless ($self->nolog) {
        
        # If log rotation is on, we must use date/time file names for log files,
        # Otherwise the current log file we are using will never be rotated:
        if (!$self->log_logfiledatetime && $self->log_rotation) {
            if ($self->verbose) {
                carp("NOTICE: Log file date/time file name format will be used because log rotation has been enabled\n");
            }
            $self->log_logfiledatetime(1);
        }
        
        unless (defined($self->log_filename)) {
            my $log_filename = $parent;
            $log_filename =~ s/.pl$//;
            $log_filename .= '.log';
            $self->log_filename($log_filename);
        }
        
        if (defined($self->log_path)) {
           $self->log_filename(File::Spec->catfile($self->log_path, $self->log_filename));
        }
        
        $self->{'logger'} = File::Log->new(
            {
                debug           => $self->log_debug,
                logFileName     => $self->log_filename,
                logFileMode     => $self->log_mode,
                stderrredirect  => $self->log_stderrredirect,
                StoreExpText    => $self->log_storeexptext,
                DateTimeStamp   => $self->log_datetimestamp,
                LogFileDateTime => $self->log_logfiledatetime,
            }
        ) || confess("- Error: can't create log file: [" . $self->log_filename . "]\n- Cause: $!\n");
    }
    
    $self->echo("Starting up script: [" . $self->_parent . "] whirr click");
    
    # Move into the scripts working directory:
    my $dirname = dirname($parent);
    $self->echo("Moving into path:   [" . $dirname . "] (" . getcwd() . ")");
    chdir($dirname);
    
    # Rotate logs if required:
    if ($self->log_rotation) {
        $self->log_rotate();
    }
    
    return $class->meta->new_object(
        __INSTANCE__ => $self,
        @_,
    );
}
################################################################################
# Method to lock the calling script so only one instance can run
################################################################################
sub locker {
    my $self    = shift;
    
    unless ( defined($self->_self_fh) ) {
        open(SELF_FH,">>",$self->_parent)
            || confess("\n- Error: Cannot open [" . $self->_parent . "]\n- Cause: $!\n");
        
        unless ( flock(SELF_FH, LOCK_EX|LOCK_NB) ) {
            confess("\n- Error: [" . $self->_parent . "] is already running\n- Cause: $!\n");
        }
        
        $self->_self_fh(*SELF_FH);
    }
    
    return $self;
}
################################################################################
# Method to unlock the calling script so other instances can run
################################################################################
sub unlocker {
    my $self    = shift;
    
    if ( defined($self->_self_fh) ) {
        close($self->_self_fh);
        $self->_self_fh(undef);
    }
    
    return $self;
}
################################################################################
# Method to print & log message depending on the demands of the script
################################################################################
sub echo {
    my ($self, $message, $debug) = @_;
    
    unless (defined($debug)) {
        $debug = $self->log_debug;
    }
    
    unless ($self->nolog) { 
        $self->logger->msg($debug, "+ " . $message . "\n");
    }
    
    if ($self->verbose && $debug <= $self->log_debug) {
        print "+ " . $message . "\n";
    }
    
    return $self;
}
################################################################################
# Method to clean white space out of strings
################################################################################
sub trim {
    my ($self, $string) = @_;
    # Trim leading & Trailing Spaces:
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    
    # Trim leading & Trailing Tabs:
    $string =~ s/^\t+//;
    $string =~ s/\t+$//;
    
    return $string;
}
################################################################################
# Method to rotate logs
################################################################################
sub log_rotate {
    my $self    = shift;
    
    my $logs_compressed = 0;
    my $logs_deleted    = 0;
    
    $self->echo("Looking for logs to rotate in path: [" . $self->log_path . "]");
    
    opendir(LOG_DIR, $self->log_path)
        || confess("\n- Error, can't open log directory for reading: [" . $self->log_path . "]\n- Cause: $!\n");
    
    while (my $log_file = readdir(LOG_DIR)) {
        
        # Only looking for files that match log pattern:
        my $_log_pattern_match = $self->_log_pattern . "\$";
        my $zip_pattern_match = $self->_log_pattern . ".zip\$";
        next if ($log_file !~ /$_log_pattern_match/i && $log_file !~ /$zip_pattern_match/i);
        
        my $fullpath_log_file;
        if ($self->log_path eq '.') {
            $fullpath_log_file = $log_file;
        } else {
            $fullpath_log_file = File::Spec->catfile($self->log_path, $log_file);
        }

        # And definately skip the current log file we are using:
        if(File::Spec->canonpath($self->logger->getLogFileName()) eq $fullpath_log_file) {
            $self->echo("Skipping current log file (in use): [" . $fullpath_log_file . "]", 10);
        }

        # Get stat info about the log file:
        my @file_info = stat($fullpath_log_file);

        # Current epoch time:
        my $now_epoch = time();
        
        my $log_file_age = (($now_epoch - $file_info[10]) / 86400);

        # If log_zip_after_days is 0 don't do zipping:
        unless ($self->log_zip_after_days == 0) {
            if ($log_file_age >= $self->log_zip_after_days && $log_file !~ /$zip_pattern_match/i) {
                
                $self->echo("Found log file to compress: [" . $fullpath_log_file . "] Age: [" . $log_file_age . "] days old");
                
                my $zip_file = $fullpath_log_file . '.zip';
                $self->echo("Compressing: [" . $fullpath_log_file . "] As: [" . $zip_file . "]");
                
                # Create a zip file object:
                my $zip = Archive::Zip->new();
                
                # Add the log file from disk:
                my $file_member = $zip->addFile($fullpath_log_file);
   
                # Save the zip file:
                unless ($zip->writeToFileNamed($zip_file) == AZ_OK) {
                    confess("\n- Error, can't write zip file: [" . $zip_file . "]\n- Cause: $!\n");
                }
                
                $logs_compressed++;
                
                # Reomove the log file that has been compressed:
                unlink($fullpath_log_file);
                
                $fullpath_log_file = $zip_file;
                
            }
        }

        # If log_rm_after_days is 0 don't do deletions:
        unless ($self->log_rm_after_days == 0) {
            if ($log_file_age >= $self->log_rm_after_days) {
                
                $self->echo("Found log file to remove: [" . $fullpath_log_file . "] Age: [" . $log_file_age . "] days old");
                $self->echo("Deleting: [" . $fullpath_log_file . "]");
                unlink($fullpath_log_file);
                $logs_deleted++;
                
            }
        }
        
    }
    
    $self->echo("Total logs compressed: [" . $logs_compressed . "]");
    $self->echo("Total logs deleted:    [" . $logs_deleted . "]");
    
    return $self;
    
}
################################################################################
# Desstructor:
################################################################################
sub DESTROY {
    my $self    = shift;
    
    $self->unlocker();
    
    # End benchmark timing:
    $self->_bench_end(new Benchmark);
    
    # Calculate execution time:
    my $diff = timediff($self->_bench_end, $self->_bench_start);

    # Benchmark report:
    $self->echo("Benchmark report: " . timestr($diff, 'all'));
    
    $self->echo("Shutting down script: [" . $self->_parent . "] grind clunk");
    
    # Close log file if required:
    unless ($self->nolog) {
        $self->logger->close();
    }
}
################################################################################
1;

__END__