#!/opt/perl/bin/perl -w
# 
#
# This code copyright 2002-2003 by
# D. W. Eaton, Artronic Development, Phoenix, AZ -- dwe@arde.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported and is not warranteed to perform any particular
# function. Contact dwe@arde.com for aditional information.
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author at dwe@arde.com.
#
# Logical revision history:
#  1.0 -  DWE Initial version
#
# Pragmas
use strict;
#
BEGIN
{
 # Could set module libs here, for example:
 # unshift (@INC, '/opt/template/lib/utilities');
}

# Environment
use Getopt::Long;
# In some environments, modules exist to define common items, use it:
##use Constants;

# Define local data
# Variables:
my (
$adjust,
$all,
$datesep,
$datestamp,
$ercf_noinfile,
$ercf_opexist,
$ercf_ok,
$ercf_user,
$false,
$newfile,
$numargs,
$numerrexist,
$numerrnoin,
$opt_adjust,
$opt_help,
$opt_prefix,
$opt_quiet,
$opt_replace,
$opt_showerror,
$opt_syntax,
$opt_useyear,
$opt_verbose,
$opt_version,
$opt_veryverbose,
$opt_veryveryverbose,
$progname,
$replacedefault,
$status,
$thisdate,
$thisdir,
$thisfile,
$thisleaf,
$thistime,
$timesep,
$true,
$userid,
$versn
);
# Arrays:
my (
@opts
);
# Hashes:
my (
%ermcf,
%opt
);

# These should come from "Constants" utility module:
$true  = 1;  # truth values
$false = 0;
$all   = 2; # for Getopt ignore case
use vars ('$true','$false','$all');
#
# Program configuration 'constants':
$versn = '1.0 - 14 JUL 2003';           # Code version and modify date
#
# Exit status codes:
$ercf_ok = 0;$ermcf{$ercf_ok} = 'Exit OK';
$ercf_noinfile = 1;$ermcf{$ercf_noinfile} = 'Can\'t find input file';
$ercf_opexist = 2;$ermcf{$ercf_opexist} = 'Output file already exists';
$ercf_user = 99;$ermcf{$ercf_user} = 'User syntax error';
#
$| = $true; # Don't buffer output
#
# Some more-like configuration items:
# Default for the --replace option ($true or $false)
# $false requires the user to supply --replace to overwrite output
# $true always overwrites output without asking for confirm
$replacedefault = $false; # Default for the --replace option
#
# Character used for time separator
$timesep = '.';
$datesep = '-';
#
# Specific configurable values:
# (add your configuration items here)
# ---- end normal configuration items --------------------
#
# Specific initialization:
$numerrexist = 0; # No errors of existing target files yet
$numerrnoin = 0; # No errors of missing files yet
#
# Try to determine user name
$userid = getlogin || getpwuid ($<) || $ENV{'USER'} || $ENV{'LOGNAME'};

if (! defined ($userid))
{
 die "Can't figure out the user name!\n";
}
#
chomp ($progname = `basename $0`); # Get our leaf name
#
# Process command line
$opt_adjust = 'adjust';
$opt_help = 'help';
$opt_prefix = 'prefix';
$opt_quiet = 'quiet';
$opt_replace = 'replace';
$opt_showerror = 'showerror';
$opt_syntax = 'syntax';
$opt_useyear = 'useyear';
$opt_verbose = 'verbose';
$opt_version = 'version';
$opt_veryverbose = 'veryverbose';
$opt_veryveryverbose = 'veryveryverbose';
#
$opt{$opt_adjust}      = ''; # defaults
$opt{$opt_help}        = $false;  # defaults
$opt{$opt_prefix}      = '';
$opt{$opt_quiet}       = $false;
$opt{$opt_replace}     = $replacedefault;
$opt{$opt_showerror}   = $false;
$opt{$opt_syntax}      = $false;
$opt{$opt_useyear}     = $false;
$opt{$opt_verbose}     = $false;
$opt{$opt_version}     = $false;
$opt{$opt_veryverbose} = $false;
$opt{$opt_veryveryverbose} = $false;
#
# Initialize accepted options:
@opts = qw(
  adjust=s
  help|h
  in=s
  keep|k
  prefix=s
  quiet|q
  replace|r
  showerror|shoerr|se|e
  syntax
  useyear|year
  verbose|v
  version
  veryverbose|vv
  veryveryverbose|vvv
);
#
# Process command-line
$Getopt::Long::bundling = $true;  # perl 5.003 and earlier will complain about this
$Getopt::Long::ignorecase = $all;
GetOptions (\%opt, @opts);
#
# Check supplied options:
if ($opt{$opt_veryveryverbose})
{
 # Force veryverbose (if it was not already called out)
 $opt{$opt_veryverbose} = $true;
}
#
if ($opt{$opt_veryverbose})
{
 # Force verbose (if it was not already called out)
 $opt{$opt_verbose} = $true;
}
#
if ($opt{$opt_version})
{
 print STDERR "$progname v$versn\n";
 exit ($ercf_user); # Quit after showing version
}
#
if ($opt{$opt_help} || $opt{$opt_syntax})
{
 &syntax_message ();
 exit ($ercf_user);
}
if ($opt{$opt_showerror})
{
 &show_error_codes(%ermcf); # Sho error codes
 exit ($ercf_user);
}
#
# ----------
#
# Check rest of arguments
#
# Specific initialization following option gathering:
# (add your initialization items here)
#
# - - - Start work - - - - - - -
# Main body of the code
#
if ($opt{$opt_verbose})
{
 # Show stuff if we want to
}
#
# Preceed the file name with the last modified date and time
#
#  dateit filename
# --------------------------- logic ----------------------------------
# Deal with a possible adjustment to time
$adjust = 0;
if ($opt{$opt_adjust})
{
 $adjust = $opt{$opt_adjust}; # Use value passed by user
}
#
# Get command line arguments:
$numargs = scalar (@ARGV) ;
if (! $numargs)
{
 print STDERR "Error: should have at least 1 argument (filename), found $numargs\n";
 exit ($ercf_noinfile);
}
else
{
 while ($numargs)
 {
  $thisfile = shift (@ARGV) ;
  if (-f "$thisfile")
  {
   # File exists, so keep going
   if ($thisfile =~ /\//)
   {
    # arg has a dir name too
    $thisdir = $thisfile;
    $thisdir =~ s/\/[^\/]+$//; # Isolate directory name
    $thisleaf = $thisfile;
    $thisleaf =~ s/^.*\///; # Isolate leaf name
   }
   else
   {
    # Simple file name
    $thisleaf = $thisfile;
    $thisdir = ''; # No dir name
   }
   # Get the file's last mod date/time:
   ($thisdate,$thistime) = &getmoddate($adjust,"$thisfile");
   $datestamp = "$opt{$opt_prefix}${thisdate}${timesep}${thistime}${datesep}";
   if (! $opt{$opt_useyear})
   {
    # Not full year in new file name
    $datestamp =~ s/^..//; # Trim century digits
   }
   # Make new file name
   if ($thisfile =~ /\//)
   {
    # Oops, don't forget leadin dir
    $newfile = $thisdir . '/' . $datestamp . $thisleaf;
   }
   else
   {
    # Just make simple filename
    $newfile = $datestamp . $thisleaf;
   }

   if (-f $newfile &&
       ! $opt{$opt_replace})
   {
    print STDERR "ERROR: '$newfile' already exists, cannot change '$thisfile'\n";
    $numerrexist++;
   }
   else
   {
    rename ("$thisfile", "$newfile") ;
    print "Changed '$thisfile' to '$newfile'\n" if ($opt{$opt_verbose});
   }
  }
  else
  {
   # Oops, declared file did not exist
   print STDERR "ERROR: '$thisfile' was not found\n";
   $numerrnoin++; # Bump number of errors
  }
  $numargs = scalar (@ARGV) ; # compute remaining args
 }
}
#
# - - - End work - - - - - - - -
#
if ($numerrnoin)
{
 print STDERR "ERROR: $numerrnoin input file(s) did not exist\n";
 exit ($ercf_noinfile); # One or more input files did not exist
}
elsif ($numerrexist)
{
 print STDERR "ERROR: $numerrexist input file(s) did not exist\n";
 exit ($ercf_noinfile); # One or more input files did not exist
}
else
{
 exit ($ercf_ok); # Whew, must be OK
}
### End.
# - - - - - - - - - - - subroutines - - - - - - -
# Local subroutines
# ----------
# Get date-time modified for specified file
sub getmoddate
{
 my ($adjust,$thisfile) = @_;
 my ($thisdate,$thistime);
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    $atime,$mtime,$ctime,$blksize,$blocks);
 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
 #
 # Work on file:
 if (-e $thisfile)
 {
  # File exists ... get times (via "stat")

  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    $atime,$mtime,$ctime,$blksize,$blocks)
                          = stat($thisfile);

  if ($adjust)
  {
   $mtime = $mtime + $adjust; # Adjust time if needed
  }
  if ($opt{$opt_verbose})
  {
   print "  modified=$mtime";
  }
  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
  $mon++;
  $wday++;
  if ($year < 1900)
  {
   $year = $year + 1900; # Flakey y2k fix
  }
  $thisdate = sprintf ("%04.0f%02.0f%02.0f",$year,$mon,$mday);
  $thistime = sprintf ("%02.0f%02.0f%02.0f",$hour,$min,$sec);
  if ($opt{$opt_verbose})
  {
   print " ($thisdate.$thistime)\n";
  }
  return ($thisdate,$thistime);
 }
 else
 {
  if ($opt{$opt_verbose})
  {
   print STDERR "Error: file '$thisfile' not found\n";
  }
  return (0,0);
 }
}
# ----------
# Standard subroutines
# ----------
# Print syntax message
sub syntax_message
{
 my ($progname);
 my ($key);
 my ($toolid);

 chomp ($progname = `basename $0`);
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
Version $versn

Name: $progname - Rename files with date
   Rename the designated file(s) to prepend the last modified
   date and time to the filename.+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+

Syntax:

+;
 }
 # Always show this line:
 print STDERR "   $progname  [ options ]  filename [... filenameN]\n";
 if ($opt{$opt_syntax} && $opt{$opt_verbose})
 {
  print STDERR  qq+
   Operational options:
   --$opt_adjust=n,--$opt_prefix=p,--$opt_useyear+;
if (! $replacedefault)
{
  print STDERR  qq+,--$opt_replace+;
}
  print STDERR  qq+
   Assistance options:
   --$opt_help,--$opt_quiet,--$opt_showerror,--$opt_syntax,--$opt_verbose,--$opt_version,--$opt_veryverbose,--$opt_veryveryverbose
+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
If present, the positional argument is assumed to be the name of the
file to be changed. Multiple positional arguments may be specified to
indicate multiple files to be renamed.+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+

Where 'options' are:

   --$opt_adjust=n
     Adjust the modify date by the specified number of seconds
   --$opt_prefix=p
     Prefix string to be used in front of the date string+;

if (! $replacedefault)
{
 # Only show this if it is not defaulted to "true"
  print STDERR  qq+
   --$opt_replace, -r
       Replace an existing file (if it exists) with the new file
       (default is to not over write an existing file)+;
}
  print STDERR  qq+
   --$opt_useyear, --year
       Use the full year (including the century) in the date string.

  Help and assistance options:

   --$opt_help, -h
       Print this help message
       (use --$opt_verbose or --$opt_veryverbose for extended help)
   --$opt_quiet, -q
       Quiet mode--don't show advisory info or warnings unless verbose
       is also selected (errors still are shown)
   --$opt_showerror, --shoerr, --se, -e
       Show brief descriptions of error exit codes from this routine
   --$opt_syntax
       Only show the syntax line of this help, not all the other info
       (use with --$opt_verbose for slightly more syntax info)
   --$opt_verbose, -v
       Verbose mode, show some diagnostics as well as the input path read
       and the output path written (or show more --help info)
   --$opt_version
       Display the version number of this routine
   --$opt_veryverbose, --vv
       Very verbose mode (implies --$opt_verbose), show more information
       in addition to all --$opt_verbose info
   --$opt_veryveryverbose, --vvv
       Very very verbose mode (implies --$opt_veryverbose), show more information
       in addition to all --$opt_veryverbose info
+;
 }

 if ($opt{$opt_veryverbose} && ! $opt{$opt_syntax})
 {
  &show_error_codes(%ermcf); # Sho error codes
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
EXAMPLES

  Prepend date and time string to 'filename'
   $progname filename

  Prepend date (including century) and time string to 'filename'
   $progname --$opt_useyear filename

  Prepend 'd', then date (including century) and time string to these files
   $progname --$opt_prefix=d --$opt_useyear filename1 filename2
+;
 }
}

# ----------
# Sho error codes
#  &show_error_codes(%ermcf);
# where: %ermcf is a hash of the error exits and reasons
sub show_error_codes
{
 my (%ermcf) = @_;
 my ($key);

 print STDERR  qq+
Error exit codes:
+;
 foreach $key (sort keys %ermcf)
 {
  printf STDERR ("%5s  =  %s\n",$key,$ermcf{$key});
 }
}
# ----------
