get a copy of the script

#!/usr/bin/perl
$version_info = "0.9 updated: <2006-03-06>";
# ===========================================================================
# fl - file manipulator
# 
# History
#  2006-03-06   tpb   0.9   add functions add_cr, rm_cr
#
# Notes:
#    This software is licensed under the CC-GNU GPL. For the full text of
#    the license, see http://creativecommons.org/licenses/GPL/2.0/
# ===========================================================================
# 
# find modules in the same directory that this script lives in
#
BEGIN 
{
($path = $0) =~ s|/[^/]+$||;
push(@INC, $path);
}
use Dispatcher;
use File::Basename;
use POSIX;
use Getopt::Long;
use Executor;
# GetOptions("n!" => $noexec);
# $do = Executor->new(0 == $noexec);
$dsp = Dispatcher->new(sub_prefix => "fl_",
help_prefix => "flh_");
$dsp->dispatch(@ARGV);
# $function = "fl_" . $ARGV[0];
# if ($main::{$function})
# {
#    eval("$function()");
# }
# else
# {
#    print("$0: no such functionn");
# }
# ---------------------------------------------------------------------------
# make atime match mtime
sub fl_set_atime_to_mtime
{
foreach $filename (@_)
{
@s = stat($filename);
utime($s[9], $s[9], $filename);
}
}
# ---------------------------------------------------------------------------
# make atime match mtime
sub fl_set_mtime_to_atime
{
foreach $filename (@_)
{
@s = stat($filename);
utime($s[8], $s[8], $filename);
}
}
# ---------------------------------------------------------------------------
sub fl_diff
{
my ($do, $filename, $dirname, $counterpath);
$exec = 1;
GetOptions("-exec!" => $exec);
$do = Executor->new($exec, 1);
shift @ARGV;
foreach $filename (@ARGV)
{
# print("$filenamen");
$dirname = dirname($filename);
if (-d "$dirname/old")
{
$dirname = "$dirname/old";
}
my $counterpath = most_recent_prefix_match($dirname, 
basename($filename));
$do->psys("diff $counterpath $filename");
}
}
# ---------------------------------------------------------------------------
sub fl_revert
{
my ($exec, $do, $filename, $dirname, $counterpath);
$exec = 1;
GetOptions("-exec!" => $exec);
$do = Executor->new($exec);
shift @ARGV;
foreach $filename (@ARGV)
{
# print("$filenamen");
$dirname = dirname($filename);
if (-d "$dirname/old")
{
$dirname = "$dirname/old";
}
my $counterpath = most_recent_prefix_match($dirname, 
basename($filename));
$do->psys("mv ${filename} ${filename}.new");
$do->psys("mv $counterpath $filename");
}
}
# ---------------------------------------------------------------------------
sub fl_rm_cr
{
shift @ARGV;
foreach $filename (@ARGV)
{
@d = ();
open(IN, "< $filename");
@d = <IN>;
close(IN);
grep { s/r//g; } @d;
open(OUT, "> ${filename}.$$");
print OUT @d;
close(OUT);
rename("$filename", "${filename}~");
rename("${filename}.$$", "$filename");
}
}
# ---------------------------------------------------------------------------
sub fl_times
{
my ($exec, $do, $filename, $dirname, $counterpath);
shift @ARGV;
foreach $filename (@ARGV)
{
@s = stat($filename);
print("$filename:n   ");
printf("A: %s; M: %s; C: %sn",
strftime("%Y-%m-%d %H:%M:%S", localtime($s[8])),
strftime("%Y-%m-%d %H:%M:%S", localtime($s[9])),
strftime("%Y-%m-%d %H:%M:%S", localtime($s[10])));
}
}
# ---------------------------------------------------------------------------
sub fl_save
{
my ($exec, $do, $filename, $dirname, $counterpath);
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime);
my ($sec,$min,$hour,$mday,$mon,$year, $newname, $mtime_in_name);
$exec = 1;
GetOptions("-exec!" => $exec,
"-mtime!" => $mtime_in_name);
$do = Executor->new($exec);
shift @ARGV;
foreach $filename (@ARGV)
{
# print("$filenamen");
$dirname = dirname($filename);
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime)
= stat($filename);
if ($mtime_in_name)
{
($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
}
else
{
($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
}
# $filename = basename($filename);
$newname = sprintf("%s.%04d-%02d-%02d", 
basename($filename), 1900+$year, 1+$mon, $mday);
if (-d "$dirname/old")
{
$dirname = "$dirname/old";
}
my $newname_ex = $newname;
my $ext = "a";
while (-e "$dirname/$newname_ex")
{
$newname_ex = sprintf("%s.%s", $newname, $ext++);
}
$do->psys("cp -p $filename $dirname/$newname_ex");
if ($? != 0)
{
exit ($? >> 8);
}
}
}
# ---------------------------------------------------------------------------
sub fl_unreadable
{
my ($exec, $do, $filename, $dirname, $counterpath);
shift @ARGV;
GetOptions("-exec!" => $exec,
"-recursive!" => $recursive);
foreach $dir (@ARGV)
{
unreadable_r($dir, $recursive);
}
}
# ---------------------------------------------------------------------------
# potentially recursive readability check
sub unreadable_r
{
my (@list, $filename);
my ($dir, $recursive) = @_;
opendir(DIR, "$dir");
@list = grep(!/^..?$/, readdir(DIR));
closedir(DIR);
foreach $filename (@list)
{
if (! -r "$dir/$filename")
{
print("$dir/$filenamen");
}
elsif ((-d "$dir/$filename") && ($recursive))
{
unreadable_r("$dir/$filename", $recursive);
}
}
}
# ---------------------------------------------------------------------------
# return the path of the newest file in $dir that prefix-matches $filename,
# but does not match exactly ($filename does not contain a path, only a 
# filename
sub most_recent_prefix_match
{
my ($dir, $filename) = @_;
opendir(DIR, $dir);
@list = grep(/^$filename./, readdir(DIR));
closedir(DIR);
foreach $file (@list)
{
@si = stat("$dir/$file");
if ($recent_time < $si[9])
{
$recent_time = $si[9];
$recent_file = $file;
}
}
return "$dir/$recent_file";
}
__END__
=head1 NAME
fl - file manipulator
=head1 SYNOPSIS
fl [-noexec] {save|diff|revert} file file file ...
fl [-noexec] [-nopreserve] {apply|backout} filename
=head1 DESCRIPTION
The script fl contains a number of subfunctions. In the order they are
most likely to be used, they are:
- save: saving the current version of file as a dated generation
file (a generation is a previous version of a file)
- diff: examining the differences between the current version of a
file and its most recently saved generation
- revert: reverting to the most recently saved generation of a
file
- apply: applying a set of individual files
- backout: backing out a set of files applied with apply
The first three operate on individual files, although multiple
filenames can be given on the command line. The last two operate on
groups of files. 
=head2 Options
The B<-noexec> option causes the script to report what it would do
without actually copying or moving any files. The option can be
abbreviated to B<-n>
=head2 Subfunctions
In alphabetical order, each of the subfunctions are
described below:
apply
From the current directory, copy the files listed in <filename> to
the appropriate places, preserving the original files before
copying new ones. Each line in <filename> should contain the
complete path of the file to be installed. The new copy of each
file should be in the current directory.
backout
Revert files listed in <filename> from the original copies saved by
apply.
diff
Run diff on the current file and the most recently saved copy.
revert
The most recent saved copy of the file is retrieved. The updated
copy of the file is moved to <filename>.new. If, in the directory
where the file lives, there is a subdirectory named 'old', it is
expected that old generations of files will be in the 'old'
subdirectory.
save
Make a copy of each file mentioned on the command line, appending
it's mtime in the form YYYY-MM-DD to the name and preserving mtime
on the the copy. This is generally a good thing to do before making
changes to sensitive system configuration files, important admin
scripts, etc. In the jargon of this document, each saved copy of a
file is called a 'generation'.
If necessary, to avoid filename collisions, the script will append
a lowercase letter to the end of the filename, beginning with "a".
If a filename includes a path, the generation will be created under
the same directory that contains the original file. If an 'old'
sub-directory is present, the generation will be written there.
=cut