Always have a backup...

I don't know about you, but I've been known to make a mistake every now and again. After a particularly egregious oops moment, I wrote stamp.pl. This script doesn't do anything particularly impressive -- it just makes a date stamped copy of any file you pass in -- but it's saved my bacon more than once. I find it particularly useful to have in the "Send To" right-click menu in Windows Explorer (although it's in all of my home directories, and in my path on Solaris -- I use it everywhere).

I'm attaching the whole script -- it's bigger than it strictly needs to be, but you get to see my template for building anything in perl. If you want to use it, you'll need to replace XYZ with a valid hostname for your environment. You can also run perldoc or pod2html on the script to see the documentation.

#!/usr/bin/perl

=head2 stamp.pl

=head4 Main Comment Block

##########################################################################
## Script Name : stamp.pl (may be called stamp w/o the .pl) ##
## Created : 01/31/2006 ##
## Author : John McDevitt ##
## Function : date stamp a file ##
## : ##
## Usage : stamp.pl file ##
## : ##
## : ##
## Notes : ##
## : include debugging messages by calling debug_msg ##
## : e.g., debug_msg("about to do something weird"); ##
## : can have multiple levels of debug info -- see the ##
## : mailto code in the do_setup routine for examples. ##
## : ##
## Update Log : 2/6/2005 -- add $ to pattern match to anchor it to ##
## : the end of the file path. ##
## : ##
##########################################################################

=cut

use strict;
use Getopt::Long;
use IO::File;
use POSIX qw(tmpnam);
use File::Copy;

my ($opt_debug,$opt_mailto,$opt_help);
my ($hostname,$temp_file_name,$temp_file_handle);
my ($oldfile,$newfile,$filedir,$filebase,$fileext,$date);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
my ($smtp);
do_setup();

##########################################################################
## Real code follows ##
##########################################################################

$oldfile = shift(@ARGV) || die "usage: stamp \n";
if ($oldfile =~ /(\w+)\.(\w+)$/){
$filedir = $`;
$filebase = $1;
$fileext = $2;
} elsif ($oldfile =~ /(\w+)$/){
$filedir = $`;
$filebase = $1;
}
if ($fileext) {
debug_msg("directory is $filedir, base is $filebase, extension is $fileext");
} else {
debug_msg("directory is $filedir, base is $filebase");
}
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year = $year +1900;
$mon = $mon + 1;
unless ($mon =~ /\d\d/) {
$mon = "0" . $mon;
}
unless ($mday =~ /\d\d/) {
$mday = "0" . $mday;
}
unless ($min =~ /\d\d/) {
$min = "0" . $min;
}
unless ($hour =~ /\d\d/) {
$hour = "0" . $hour;
}
if ($fileext) {
$newfile = $filedir . $filebase . "_" . $year . $mon . $mday . "_" . $hour . $min . "." . $fileext;
} else {
$newfile = $filedir . $filebase . "_" . $year . $mon . $mday . "_" . $hour . $min;
}
debug_msg("new file is $newfile");
copy($oldfile, $newfile);

##########################################################################
## Real code precedes ##
##########################################################################

##########################################################################
## Setup code follows ##
##########################################################################

sub do_setup{
######################################################################
## GetOptions is a function exported from Getopt::Long. it is like ##
## using the perl -s flag, but is more robust in its parsing, and ##
## simpler to implement. Options must be specified to uniqueness. ##
## A colon makes a value optional and = makes a value required. ##
## Absence of either is for a switch. i and s after a colon or = ##
## indicate integer and string types. If a value isn't provided for##
## a string type, the variable gets '', if one isn't provided for an##
## integer, it gets 0. ##
######################################################################
GetOptions ('debug+' => \$opt_debug,'mailto:s' => \$opt_mailto, 'help' => \$opt_help);

debug_msg("debugging enabled");
if ($opt_mailto) {
$hostname = `hostname`;
if ($opt_debug > 1) { debug_msg("in mailto code before resetting stdout/stderr"); }
if ($opt_debug > 1) { debug_msg("debugging level is $opt_debug\n"); }
###################################################
## get a file handle to a temp file where we know##
## the file name. set it to autoflush so output ##
## isn't buffered -- need this so we know if any ##
## prints have happened when getting ready to ##
## shut down. ##
###################################################
do { $temp_file_name = tmpnam() } until $temp_file_handle = IO::File->new($temp_file_name, O_RDWR|O_CREAT|O_EXCL);
$temp_file_handle->autoflush(1);
if ($opt_debug) { debug_msg("temp file name is $temp_file_name"); }

###################################################
## the END{} block is executed when perl is exits##
## even if it is as a result of a die function or##
## from an internally generated exception, e.g. ##
## when you try to call an undefined function ##
###################################################
END {
if (-s $temp_file_name) {
use Net::SMTP;
$smtp = Net::SMTP->new('mailhost.XYZ.com');
if ($ENV{USERNAME}){
$smtp->mail($ENV{USERNAME});
} else {
$smtp->mail("$hostname");
}
$smtp->to($opt_mailto);
$smtp->data();
$smtp->datasend("To: $opt_mailto\n");
$smtp->datasend("\n");
seek($temp_file_handle,0,0) or die "seek: $!";
$smtp->datasend(<$temp_file_handle>);
$smtp->dataend();
$smtp->quit;
}
if (-e $temp_file_name) {unlink($temp_file_name) or die "Couldn't unlink $temp_file_name : $!";}
}
###################################################
## redirect standard out and error to temp file ##
###################################################
*STDOUT = *$temp_file_handle;
*STDERR = *$temp_file_handle;
debug_msg("in mailto code. sending to $opt_mailto");
}
if ($opt_help) {
print "Usage: $0 [-d|--debug] [-m=address|-mailto=address] filename\n";
print "-d options enable debugging. Can be repeated for more verbosity\n";
print "-m options enable emailing stdout and stderr\n";
print "-h Print this message and exit\n";
exit;
}
}

sub debug_msg{
if ($opt_debug) {
print "DEBUG: @_\n";
}
}

##########################################################################
## Setup code precedes ##
##########################################################################

=head2 SYNOPSIS

stamp.pl [-d] [-m john.mcdevitt@XYZ.com] filename

=head2 DESCRIPTION

creates a copy of the input file in the same location with a date/time stamp

=head2 EXAMPLES

=over 4

=item 1.

C

Returns help message:
Usage: ./stamp.pl [-d|--debug] [-m=address|-mailto=address] filename
-d options enable debugging. Can be repeated for more verbosity
-m options enable emailing stdout and stderr
-h Print this message and exit


=item 2.

C

copies test.txt to test_20060131_1349.txt

=item 3.

C

copies test to test_20060131_1349

=back

=cut