my %locations = Get_Program_Locations(@args);

Update_Code('lib/FileHandle/Unget.pm', \%locations);
Update_Code('lib/Test/Utils.pm', \%locations);

return %locations;
}

# --------------------------------------------------------------------------

sub Update_Code { my $filename = shift; my %locations = %{ shift @_ };

my $code = _Read_Code($filename);

foreach my $program (keys %locations)
{
  if (defined $locations{$program})
  {
    $locations{$program} = "\'$locations{$program}\'";
  }
  else
  {
    $locations{$program} = "undef";
  }
}

if ($code =~ /(PROGRAMS = \(.*?\))/s)
{
  my $original_programs = $1;
  my $new_programs = $original_programs;

  $new_programs =~ s/('diff' *=> *).*?,/$1$locations{diff},/;
  $new_programs =~ s/('grep' *=> *).*?,/$1$locations{grep},/;
  $new_programs =~ s/('tzip' *=> *).*?,/$1$locations{tzip},/;
  $new_programs =~ s/('gzip' *=> *).*?,/$1$locations{gzip},/;
  $new_programs =~ s/('compress' *=> *).*?,/$1$locations{gzip},/;
  $new_programs =~ s/('bzip' *=> *).*?,/$1$locations{bzip},/;
  $new_programs =~ s/('bzip2' *=> *).*?,/$1$locations{bzip2},/;

  $code =~ s/\Q$original_programs\E/$new_programs/;
}
else
{
  die "Couldn't find programs hash in MessageParser.pm";
}

_Write_Code($filename, $code);
}

# --------------------------------------------------------------------------

sub _Read_Code { my $filename = shift;

local $/ = undef;

open SOURCE, $filename
  or die "Couldn't open file \"$filename\": $!";
my $code = <SOURCE>;
close SOURCE;

return $code;
}

# --------------------------------------------------------------------------

sub _Write_Code { my $filename = shift; my $code = shift;

open SOURCE, ">$filename"
  or die "Couldn't open grepmail file \"$filename\": $!";
print SOURCE $code;
close SOURCE;
}

# --------------------------------------------------------------------------

sub Get_Program_Locations { my @args = @_;

my %defaults = (
    'diff'     => 'diff',
    'grep'     => 'grep',
    'tzip'     => 'tzip',
    'gzip'     => 'gzip',
    'bzip2'    => 'bzip2',
    'bzip'     => 'bzip2',
);

my %programs = (
    'diff'     => undef,
    'grep'     => undef,
    'tzip'     => undef,
    'gzip'     => undef,
    'bzip2'    => undef,
    'bzip'     => undef,
);

foreach my $arg (@args)
{
  my ($var,$value) = $arg =~ /^(.*?)=(.*)$/;
  $value = undef if $value eq '';
  $programs{'diff'} = $value if $var eq 'DIFF';
  $programs{'grep'} = $value if $var eq 'GREP';
  $programs{'tzip'} = $value if $var eq 'TZIP';
  $programs{'bzip'} = $value if $var eq 'BZIP';
  $programs{'gzip'} = $value if $var eq 'GZIP';
  $programs{'bzip2'} = $value if $var eq 'BZIP2';
}

return %programs if grep {/^(DIFF|GREP|TZIP|GZIP|BZIP2?)=/} @args;

print<<EOF;
You must now specify the location of external programs for decompressing
compressed folders. You must specify the full path--otherwise you may
accidentally execute a trojan version of the decompression program.  You can
enter "none" to disable support for decompressing files of a given type.

EOF

my @path = split /$Config{path_sep}/, $ENV{PATH};

foreach my $program (sort keys %programs)
{
  my $name = $Config{$program} || $defaults{$program};

  my $full_path = Find_Program($name, [@path]);
  $full_path = $name if !defined $full_path && MM->maybe_command($name);

  $full_path = 'none' if !defined $full_path || $full_path eq '';

  my $choice = ExtUtils::MakeMaker::prompt(
    "Where can I find your \"$program\" executable?" => $full_path);

  $programs{$program} = undef, next if $choice eq 'none';

  if (File::Spec->file_name_is_absolute($choice) &&
    MM->maybe_command($choice))
  {
    $programs{$program} = $choice;
    next;
  }
  else
  {
    print "\"$choice\" does not appear to be a valid executable\n";
    redo;
  }
}

return %programs;
}

# --------------------------------------------------------------------------

sub Find_Program { my $program = shift; my @path = @{ shift @_ };

my $param = (($program =~ s/(\s+.*)//) ? $1 : '');

for my $dir (@path)
{
  my $abs = File::Spec->catfile($dir, $program);
  return $abs.$param if $abs = MM->maybe_command($abs);
}

return undef;
}

# --------------------------------------------------------------------------

sub Check_Program_Prerequisites { my %locations = @_;

Check_Diff_Version($locations{'diff'}) if defined $locations{'diff'};
Check_Grep_Version($locations{'grep'}) if defined $locations{'grep'};
Check_Tzip_Version($locations{'tzip'}) if defined $locations{'tzip'};
Check_Gzip_Version($locations{'gzip'}) if defined $locations{'gzip'};
Check_Bzip_Version($locations{'bzip'}) if defined $locations{'bzip'};
Check_Bzip2_Version($locations{'bzip2'}) if defined $locations{'bzip2'};
}

# --------------------------------------------------------------------------

sub Check_Diff_Version { my $program = shift;

# Right now we pass everything until we hear about a version which doesn't
# work.
}

# --------------------------------------------------------------------------

sub Check_Grep_Version { my $program = shift;

my $version = `$program --version`;

unless ($version =~ /\bGNU\b/)
{
  warn "\n$program is not GNU grep!\n";
  return;
}

$version =~ s/^.*?([\d.]+)\n.*/$1/s;

my $version_number;

# Converts 2.5.1 into 2.0501 for comparison later. (I assume that we'll
# never have a subversion number greater than 99)
{
  my $exponent = 0;
  $version =~ s/(\d+)/$version_number += $1 * (10 ** $exponent);$exponent -= 2; $1/ge;
}

# 2.0 fails, according to David N. Blank-Edelman <dnb@ccs.neu.edu>
warn "\nYour version of GNU grep is too old.\n"
  unless $version_number >= 2.01;
}

# --------------------------------------------------------------------------

sub Check_Tzip_Version { my $program = shift;

# Right now we pass everything until we hear about a version which doesn't
# work.
}

# --------------------------------------------------------------------------

sub Check_Gzip_Version { my $program = shift;

# Right now we pass everything until we hear about a version which doesn't
# work.
}

# --------------------------------------------------------------------------

sub Check_Bzip_Version { my $program = shift;

# Right now we pass everything until we hear about a version which doesn't
# work.
}

# --------------------------------------------------------------------------

sub Check_Bzip2_Version { my $program = shift;

# Right now we pass everything until we hear about a version which doesn't
# work.
}

cpanm FileHandle::Unget

perl -MCPAN -e shell
install FileHandle::Unget