#!/usr/bin/perl -w

###############################################################################
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is Patch Maker.
#
# The Initial Developer of the Original Code is
# Gervase Markham <gerv@gerv.net>.
# Portions created by the Initial Developer are Copyright (C) 2002-2006
# the Initial Developer. All Rights Reserved.
#
# Contributor(s): David Koppenhofer <dkoppenh@null.net>
#                 Steve Chapel <stevechapel@earthlink.net>
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
#
# This software was written to the Glory of God.
# ***** END LICENSE BLOCK *****
###############################################################################

use strict;

###############################################################################
# This is version
my $pm_version = "3.1";
# of Patch Maker.
###############################################################################

###############################################################################
#
# Global Variables
#
###############################################################################

###############################################################################
# Command we are running (short or long form)
###############################################################################
my $command;

###############################################################################
# pm configuration hash - defaults overridden by .pmrc
###############################################################################
my %config;

###############################################################################
# Current patch reference
###############################################################################
my $patchref;

###############################################################################
# Hash containing of all the valid Patch Maker commands.
###############################################################################
my %commands =
(
  "add"         => \&pmadd,         "a"  => \&pmadd,
  "checkin"     => \&pmcheckin,     "i"  => \&pmcheckin,
  "scmadd"      => \&pmscmadd,      "sa" => \&pmscmadd,
  "cvsadd"      => \&pmscmadd,      "ca" => \&pmscmadd,
  "diff"        => \&pmdiff,        "d"  => \&pmdiff,
  "edit"        => \&pmedit,        "e"  => \&pmedit,
  "execute"     => \&pmexecute,     "x"  => \&pmexecute,
  "grep"        => \&pmgrep,        "g"  => \&pmgrep,
  "help"        => \&pmhelp,        "h"  => \&pmhelp,
  "list"        => \&pmlist,        "l"  => \&pmlist,
  "patch"       => \&pmpatch,       "p"  => \&pmpatch,
  "remove"      => \&pmremove,      "r"  => \&pmremove,
  "rename"      => \&pmrename,      "rn" => \&pmrename,
  "switch"      => \&pmswitch,      "s"  => \&pmswitch,
  "update"      => \&pmupdate,      "u"  => \&pmupdate,
  "view"        => \&pmview,        "v"  => \&pmview,
  "version"     => \&pmversion,
  "which"       => \&pmwhich,       "w"  => \&pmwhich
);

my %scmcommands;

###############################################################################
#
# Helper Subroutines
#
###############################################################################

use File::Spec;
use File::Copy;
use File::Basename;
use Cwd;

###############################################################################
# fatal_error()
#
# Dies with the given error message
###############################################################################
sub fatal_error( $ )
{
  die basename($0) . ": " . shift() . "\n";
}

###############################################################################
# message()
#
# Print a message adorned with the program name
###############################################################################
sub message( $ )
{
  print basename($0) . ": " . shift() . "\n";
}

###############################################################################
# ask()
#
# Ask the user a question.
###############################################################################
sub ask( $ )
{
  my $message = (shift @_) . " [y]? ";
  print $message;
  return (<STDIN> =~ m/^(y(es)?)?\n$/i);
}

###############################################################################
# deprecate()
# 
# Print a "deprecated" message.
###############################################################################
sub deprecate( $ )
{
  print "*" x 78 . "\n" .
        "  Note: The name you used for this command is deprecated, and may " .
        "disappear.\n  The new name for this command is $_[0].\n" . 
        "*" x 78 . "\n";
}

###############################################################################
# get_path()
#
# Returns the path to an important file. If the path depends on a patchref,
# you can pass it as an optional second parameter, otherwise it uses the
# current one from the global variable.
###############################################################################
sub get_path
{
  my $pathid = shift;
  my $localpr = shift || $patchref;
  my $path;

  if ($pathid eq "patchref")
  {
    $path = File::Spec->catfile($config{'datadir'}, "patchref");
  }
  elsif ($pathid eq "diff")
  {
    $path = File::Spec->catfile($config{'datadir'}, "$localpr.diff");
  }
  elsif ($pathid eq "filelist")
  {
    # The file list is the list of files in the current patch, in their
    # canonical locations.
    $path = File::Spec->catfile($config{'datadir'}, "$localpr.files");
  }
  else
  {
    fatal_error("Internal error: unknown path ID: '$pathid'.");
  }
  
  return($path);
}

###############################################################################
# get_file_list()
#
# Return the files as a list or space-separated string. Returns empty list or 
# string if there are no files.
###############################################################################
sub get_file_list
{
  my $file_list = shift || get_path("filelist");
  my $diff_file = get_path("diff");
  
  if (!-e $file_list && -e $diff_file)
  {
    # We have a diff but no file list - attempt to work out file list from diff
    # by brute-force use of the 'find' command.
    open(DIFF, "<$diff_file")
             or fatal_error("Can't open file '$diff_file' for reading. $!");
    open(FILELIST, ">$file_list")    
                or fatal_error("Can't open file '$file_list' for writing. $!");
    
    while (<DIFF>)
    {
      if (/Index: (.*)/)
      {
        # Currently, we only do this for non-Windows platforms, because find 
        # doesn't exist on Windows.
        if (!-e $1 && $config{'os'} ne "windows")
        {
          # If the file doesn't have the right path on it, we work out the
          # filename and try and track it down. 
          $1 =~ /.*\/(.*)/;
          print FILELIST `find . -name $1`;
        }
        else
        {        
          print FILELIST $1 . "\n";
        }
      }
    }
  }      
  
  my @files;
  
  # FILELIST doesn't necessarily exist when this function is called
  if (open(FILELIST, "<$file_list"))
  {
    while (my $key = <FILELIST>) 
    {
      chomp $key;    
      # Backwards compatibility stuff
      next if ($key =~ /^\s*#/); # Comments
      last if ($key =~ /^---/); # Separator

      $key =~ s/(.*)\@.*/$1/ if ($key =~ /\@/);

      next if ($key eq "");    
      push(@files, $key);
    }
  
    close FILELIST;
  }
  
  return wantarray ? @files : quote_array(@files);
}

###############################################################################
# pexec()
#
# Print and run a given command line.
###############################################################################
sub pexec( $ )
{
  my ($exec) = @_;
  print $exec . "\n";
  system("$exec");
}

###############################################################################
# trim()
#
# Trim whitespace from both ends of a string
###############################################################################
sub trim( $ )
{
  my $string = shift;
  $string =~ s/^\s+//;
  $string =~ s/\s+$//;
  return($string);
}

###############################################################################
# touch()
#
# Ensure a file exists and update its last modified date
###############################################################################
sub touch( $ )
{
  my $file = shift;
  open(TOUCHEDFILE, ">>$file") or fatal_error("Can't touch file '$file'. $!");
  close TOUCHEDFILE;
}

###############################################################################
# quote_array()
#
# Takes an array and returns a string of quoted values.
###############################################################################
sub quote_array
{
  my @quoted_files;
  
  foreach my $file (@_)
  {
    # Trigger characters for quoting
    if ($file =~ /[ "]/)
    {
      # Escape internal quotes
      $file =~ s/"/\\"/g;
      
      # Add quotes
      $file = '"' . $file . '"';      
    }
    
    push(@quoted_files, $file);
  }
  
  return join(" ", @quoted_files);
}

###############################################################################
# check_scm()
#
# Makes sure we aren't trying to do a SCM operation without knowing which
###############################################################################
sub check_scm
{
  if (!$config{'scm'})
  {
    fatal_error("You've attempted to do a SCM operation, but I can't work " .
                 "out which SCM you are using.");
  }
}

###############################################################################
#
# Functions implementing Patch Maker commands
#
###############################################################################

###############################################################################
# pmadd()
#
# Adds one or more filenames to the file list.
###############################################################################
sub pmadd( @ ) 
{ 
  my @files = get_file_list();
  my @addfiles;
  my @candidates = @ARGV;
  
  # If we are given no candidates, take a newline-separated list from stdin.
  if (!scalar(@candidates))
  {
    message("No files given on command line; taking list from stdin. " .
            "Ctrl-D to finish.");
    while (<STDIN>)
    {
      chomp;
      s/^\s+//;
      s/\s+$//;
      push (@candidates, $_);
    }
  }
  
  foreach my $addfile (@candidates)
  {
    if (grep /^\Q$addfile\E$/, @files)
    {
      print "'$addfile' is already part of this patch.\n";
    }
    elsif (-f $addfile)
    {
      print "Adding file '$addfile'.\n";

      push (@addfiles, $addfile);
      
      # Make sure we don't add the same file twice if it's specified twice
      # in a batch.
      push (@files, $addfile);
    }
    else
    {
      print "File '$addfile' does not exist - not adding.\n";
    }
  }
  
  # Add the new files to the end of the list
  my $file_list = get_path("filelist");
  open(FILELIST, ">>$file_list")
              or fatal_error("Can't open file '$file_list' for appending. $!");

  foreach my $addfile (@addfiles) 
  {
    print FILELIST $addfile . "\n";    
  } 

  close FILELIST;
}

###############################################################################
# pmcheckin() 
#
# Does a checkin on all files in the file list.
###############################################################################
sub pmcheckin()
{
  # All other args to pmcheckin get passed to the SCM, In CVS's case, they
  # are post-mode commands.
  my $args = join(' ', @ARGV);

  check_scm();
  
  # We need to be really sure we know what we are doing here...
  pmwhich();
  pmupdate();
  pmdiff();
  pmview();
  
  print "*" x 60 . "\n" . 
        "*** Is the tree green and open? Have you run the tests? ***\n" .
        "*" x 60 . "\n\n";
  if (ask("Are you sure you want to check in"))
  {
    pexec($scmcommands{$config{'scm'}}->{'checkin'} . 
          " $args " . get_file_list());          
  }    
  else
  {
    message("Checkin aborted.");
  }
  
  if ($config{'scm'} eq "hg") {
    pexec("hg outgoing");
    print("\n*** Don't forget to hg push. ***\n");    
  }
}

###############################################################################
# pmscmadd()
#
# Does an SCM add operation on all files in the file list which have not been 
# added.
#
# This is a horrible implementation; it needs rewriting.
# We should check the status of each file in the CVS special files,
# and only add the ones which have not been added.
###############################################################################
sub pmscmadd()
{
  my $args = join(' ', @ARGV);

  # Deprecation notice for the old name of this command
  if ($command =~ /^ca|cvsadd$/)
  {
    deprecate("sa or scmadd");
  }

  check_scm();
  
  pexec($scmcommands{$config{'scm'}}->{'add'} . " $args " . get_file_list());          
}

###############################################################################
# pmdiff()
###############################################################################
sub pmdiff()
{
  # All other args to pmdiff get passed to diff
  my $args = join(' ', @ARGV);

  check_scm();
  
  my $diff_file = get_path("diff");
  touch($diff_file);
  
  my $files = get_file_list();
  
  if ($files eq "")
  {
    # Avoid running a diff on the entire tree.
    message("No files in the file list to diff.");
    exit;
  }
  
  # Back up the old diff
  move($diff_file, "$diff_file.bak");
  
  # Create the new diff
  pexec($scmcommands{$config{'scm'}}->{'diff'} . 
  " $args $files > $diff_file\n");

  if (-s "$diff_file")
  {
    my $newfilesize = -s $diff_file;
    my $oldfilesize = -s "$diff_file.bak";
    
    print "Patch size is $newfilesize bytes";
    if ($newfilesize == $oldfilesize)
    {
      print " (no change)";
    }
    elsif ($newfilesize < $oldfilesize * $config{'diffwarningthreshold'})
    {
       # If it's less than a certain fraction of the previous size, something 
       # might well have gone wrong. Confirm that the user really wants this.
       print ". That is only " . 
             sprintf("%.0f", $newfilesize / $oldfilesize * 100) . 
             "% of the previous size.\n";
       if (!ask("Are you sure you want to overwrite?"))
       {
         # Restore original diff
         move("$diff_file.bak", $diff_file);
         return 0;
       }
    }
    
    print "\n";
    unlink "$diff_file.bak";
  }
  else
  {
    # If it has zero size, restore the backup. This guards against the
    # situation where they forgot to apply any patches before running
    # diff - otherwise they might clobber their only copy.
    print "\n*** Warning: diff has zero size. Not overwriting. ***\n\n";
    move("$diff_file.bak", $diff_file);
    return 0;
  }
  
  return 1;
}

###############################################################################
# pmedit()
###############################################################################
sub pmedit()
{
  my @editfiles;
  my @files = get_file_list();
  $files[0] || pmlist() && exit;
  
  # Arguments to pmedit are interpreted as globs of files in the list -
  # e.g. pmedit *.cpp . 
  my $regexp = shift @ARGV;

  # If no arguments, edit them all.
  @editfiles = @files if !$regexp;
  
  # Can have more than one glob; you get the file if it matches any.
  while ($regexp)
  {
    # The following code attempts to turn a glob syntax into a regexp one
    # by first escaping all special regexp symbols from file's pathname...
    $regexp =~ s/([\[\$\\({}).+\/])/\\$1/g;   
    # ...and converting glob syntax to regexp.
    $regexp =~ s/\*/.\*/g;
    $regexp =~ s/\?/./g;
    $regexp =~ s/\#/[0-9]/g;

    push(@editfiles, grep(/$regexp/i, @files));

    $regexp = shift @ARGV;
  }
    
  if (@editfiles) 
  {
    my $editfiles = '"' . join( '" "', @editfiles ) . '"'; 
    $editfiles =~ s/\s+$//;
   
    pexec("$config{'editor'} $editfiles $config{'editor_modal'}");
  } 
  elsif (@files)
  {
    message("No filenames match the string given.");
  }
  else
  {
    # No files. pmlist() tells them so.
    pmlist(); 
  }
}

###############################################################################
# pmexecute()
###############################################################################
sub pmexecute()
{
 # All other args to pmexecute get passed to the app
  my $args = join ' ', @ARGV;
  if (!$args)
  {
      message("Please give a command to execute.");
      return;
  }
  
  my $files = get_file_list();
  
  if ($files) {
    pexec("$args $files");
  }
  else {
    message("This patch has no files yet.");
  }
}

###############################################################################
# pmgrep()
###############################################################################
sub pmgrep()
{
  my @files = get_file_list();
  
  my $pattern = join(" ", @ARGV);
  
  if ($pattern) 
  {
    if (@files) 
    {
      foreach my $file (@files)
      {
        if (!open(CODEFILE, "<$file")) 
        {
            print "Can't open file $file: $!\n";
            next;
        }

        while (<CODEFILE>)
        {      
          if (m/$pattern/i)
          {
            print "* " . $file . ":" . $. . "\n" . $_;
          }
        }
        close CODEFILE;
      }
    }
    else 
    {
      message("This patch has no files yet.");
    }
  }
  else 
  {
    message("Please give a pattern to search for.");
  }
}

###############################################################################
# pmhelp()
###############################################################################
sub pmhelp()
{
  print <<"EOF";
Usage: pm command [command-options-and-arguments]
  where command is list, diff etc.
  
Commands:

h, help         Show this message.
l, list         Show the list of files in the current patch.
v, view         Show your diff in an editor window so you can sanity-check it.
p, patch        Patch diff into the tree you are currently working with. Use
                -R to back the patch out again. 
e, edit         Opens in your editor any files in the current patch which match
                a pattern (simple glob). The bare command opens every file.
w, which        Show the current patch reference.
s, switch       Change to work with a new patch reference.
rn, rename      Change the name of the current patch.
a, add          Add a list of files to the current patch.
r, remove       Remove a list of files from the current patch.
g, grep         Case-insensitively search all added files for a given string.
version         Show the version of Patch Maker.
x, execute      Execute a command on all files in the patch.

d, diff         Tell your SCM to make a diff -pu for all the files in the patch.
                Extra arguments to this command are passed through to diff - 
                e.g. "-w". 
u, update       Tell your SCM to update and merge all the files in the patch.
sa, scmadd      Tell your SCM to add all new files in the patch.
ci, checkin     Tell your SCM to checkin all the files in the patch.

If you run "pm --init", you can also invoke Patch Maker commands in a
single-name form. E.g. the "list" command becomes "pml" or "pmlist".

For further documentation, see http://www.gerv.net/software/patch-maker/ .
Report bugs to: <gerv\@gerv.net>.

EOF
}

###############################################################################
# pminit()
###############################################################################
sub pminit()
{
  my @commands = (keys %commands);
  
  my $force_platform = shift @ARGV || "";
  
  if ((!$force_platform && ($config{'os'} =~ /^unix|darwin$/)) || 
      $force_platform =~ /unix/i) 
  {  
    # Go to the pm directory
    $0 =~ /(.*)\//;
    if ($1)
    {
      chdir("$1") or fatal_error("Can't change directory to '$1'. $!");
    }

    print "Initialising Patch Maker in this directory.\n";
    print "Creating symlinks...\n";
    foreach my $command (@commands) 
    {
      system("ln -s pm pm$command");
    }
  }
  elsif ((!$force_platform && $config{'os'} eq 'cygwin') || 
         $force_platform =~ /cygwin/i)
  {
    print "Initialising Patch Maker in this directory.\n";
    print "Creating batch files...\n";

    my $cwd = getcwd();

    my $progname = $^X;
    $progname =~ s/(.*\/)*//g;
    
    foreach my $command (@commands) 
    {
      open(BATFILE, ">pm$command.bat");
      print BATFILE "\@$progname \"$cwd/pm\" " . 
                    "--$command %1 %2 %3 %4 %5 %6 %7 %8 %9";
      close BATFILE;
    }    
    
    # Do pm itself
    open(BATFILE, ">pm.bat");
    print BATFILE "\@$progname \"$cwd/pm\" %1 %2 %3 %4 %5 %6 %7 %8 %9";
    close BATFILE;
  }
  elsif ((!$force_platform && $config{'os'} eq 'windows') || 
         $force_platform =~ /win/i)
  {
    print "Initialising Patch Maker in this directory.\n";
    print "Creating batch files...\n";

    my $cwd = getcwd();
    $cwd =~ s/\//\\/g;
    
    foreach my $command (@commands) 
    {
      open(BATFILE, ">pm$command.bat");
      print BATFILE "\@$^X \"$cwd\\" . basename($0) . 
                    "\" --$command %1 %2 %3 %4 %5 %6 %7 %8 %9";
      close BATFILE;
    }    
    
    # Do pm itself
    open(BATFILE, ">pm.bat");
    print BATFILE "\@$^X \"$cwd\\pm\" %1 %2 %3 %4 %5 %6 %7 %8 %9";
    print BATFILE "\@$^X \"$cwd\\" . basename($0) . 
                  "\" %1 %2 %3 %4 %5 %6 %7 %8 %9";
    close BATFILE;
  }
  else
  {
    print "Your platform does not require initialisation of Patch Maker.\n";
    print "You should invoke Patch Manager as e.g. 'pm --add' or 'pm -a'.\n";
  }
}
  
###############################################################################
# pmlist()
###############################################################################
sub pmlist()
{  
  # Allow listing of other patchrefs.
  # Note pmlist() also gets called internally so we have to check this is 
  # a pmlist command before looking at the first argument.
  if ($command =~ /^l(ist)?$/ && defined($ARGV[0])) {
    $patchref = $ARGV[0];
  }
  
  # cat to console
  my @files = get_file_list();
  
  if ($files[0]) 
  {
    @files = sort @files;
    
    foreach my $list_file (@files)
    {
      print $list_file . "\n";
    }
  }
}

###############################################################################
# pmpatch()
###############################################################################
sub pmpatch()
{  
  # All extra args to pmpatch get passed to patch. The most common one to use
  # in this context is -R.
  my $args = join(' ', @ARGV);
  
  my $diff_file = get_path("diff");
  if (-s $diff_file)
  {
    # Hg produces weird diffs
    my $pnumber = 0;
    if ($config{'scm'} eq "hg") {
      $pnumber = 1;
    }
    
    pexec("patch -p$pnumber $args < $diff_file");
    return 0;
  }
  else
  {
    message("No patch to apply for patch reference '$patchref'.");
    return 1;
  }
}

###############################################################################
# pmremove()
###############################################################################
sub pmremove( @ )
{
  my @files = get_file_list();
  my @candidates = @ARGV;
  
  if (!scalar(@candidates))
  {
    message("No files given on command line; taking list from stdin. " .
            "Ctrl-D to finish.");
    while (<STDIN>)
    {
      chomp;
      push (@candidates, $_);
    }
  }
  
  # We need to find which removefiles are in the files list. If any are
  # not, we need to print an error.
  # Convert lists to hashes with value 1
  my %buildfiles;
  my %removefiles;
  
  foreach my $buildfile (@files) 
  {
    $buildfiles{$buildfile} = 1;
  }

  foreach my $removefile (@candidates)
  {
    $removefiles{$removefile} = 1;
  }
  
  # Set both hash values to 0 on all matches
  foreach my $buildfile(keys %buildfiles)
  {
    if (defined($removefiles{$buildfile}))
    {
      $buildfiles{$buildfile} = 0;
      $removefiles{$buildfile} = 0;
      
      print "Removing file '$buildfile' from this patch.\n";
    }
  }
  
  # Print an error for removefiles which are still 1
  foreach my $removefile (keys %removefiles)
  {
    if ($removefiles{$removefile} == 1)
    {
      message("File '$removefile' is not part of this patch.");
    }
  }
  
  # Rewrite the file list, containing the buildfiles which are still 1
  my $file_list = get_path("filelist");
  open(FILELIST, ">$file_list")
                or fatal_error("Can't open file '$file_list' for writing. $!");

  foreach my $buildfile (@files)
  {
    if ($buildfiles{$buildfile})
    {
      print FILELIST $buildfile . "\n";
    }
  }
  
  close FILELIST;
} 

###############################################################################
# pmrename()
#
# Convenience command for renaming the current patch. Useful if you didn't
# have a bug number before, but do now.
###############################################################################
sub pmrename()
{
  # Do we have an argument? 
  my $new_patchref = $ARGV[0];
   
  if ($new_patchref)
  {
    my $file_list = get_path("filelist");
    my $diff_file = get_path("diff");
    
    if (-e $file_list)
    {
      rename($file_list, get_path("filelist", $new_patchref));
    }
    
    if (-e $diff_file)
    {
      rename($diff_file, get_path("diff", $new_patchref));
    }
    
    pmswitch();
  }
  else
  {
    message("No new patch reference given.");
    exit;
  }
}

###############################################################################
# pmswitch()
###############################################################################
sub pmswitch()
{
  # Do we have an argument? 
  my $new_patchref = shift @ARGV;
  
  if ($new_patchref)
  {
    my $patchref_file = get_path("patchref");
    open(CURRENT, ">$patchref_file") 
            or fatal_error("Can't open file '$patchref_file' for writing. $!");
    print CURRENT $new_patchref;
    print "You were working on patch '$patchref'.\n";       
    print "You are now working on ";
    if (!(-e get_path("filelist", $new_patchref)))
    {
      print "(new) ";
    }
    
    print "patch '$new_patchref'.\n";       
    close CURRENT;    
  }
  else
  {
    message("No new patch reference given.");
    exit;
  }
}

###############################################################################
# pmupdate 
###############################################################################
sub pmupdate()
{
  # All other args to pmupdate get passed to your SCM.
  my $args = join ' ', @ARGV;
  
  check_scm();
  
  my $command = $scmcommands{$config{'scm'}}->{'update'} . " $args ";
  
  # Bit of a hack, this. hg doesn't support update of individual files.
  if ($config{'scm'} ne "hg") {
    $command .= get_file_list();
  }
  
  pexec($command);
}

###############################################################################
# pmversion()
###############################################################################
sub pmversion()
{
  print "\nPatch Maker version $pm_version.\n\n";
  print "Author: Gervase Markham <gerv\@gerv.net>.\n"; 
  print "URL:    http://www.gerv.net/software/patch-maker/\n\n"; 
}

###############################################################################
# pmview()
###############################################################################
sub pmview()
{
  if (defined($ARGV[0])) 
  {
    $patchref = $ARGV[0];
  }

  my $diff_file = get_path("diff");
  
  if ($diff_file && -e $diff_file)
  {
    pexec("$config{'editor'} \"$diff_file\" $config{'editor_modal'}");
  }
  else
  {
    message("No diff file to view.");
  }
}

###############################################################################
# pmwhich()
###############################################################################
sub pmwhich()
{
  print "You are currently working on patch '$patchref'";
  print ".\n";  
}

###############################################################################
#
# Main code.
#
###############################################################################

my $home = $ENV{'HOME'} || $ENV{'APPDATA'} 
  || fatal_error("Can't find home directory for storing Patch Maker data.\n" . 
                 "Please set HOME environment variable.\n");

###############################################################################
# Configuration default values. Override these with a "name=value" file called
# .pmrc in $home.
#
# datadir      - where you want Patch Maker to keep its files. E,g.:
#                Windows: "C:\\My Documents\\pmdata"
#                Cygwin:  "'/cygdrive/c/My Documents/pmdata'"
#                Unix:    "/home/gerv/pm"
$config{'datadir'} = File::Spec->catfile($home, "pm");
#
# context      - number of lines of context in your diffs. Never set it to
#                less than 3. The more you have, the easier patches are to
#                review, but the more likely they are to bitrot.
$config{'context'} = 5;
#
$config{'diffwarningthreshold'} = 0.75;
###############################################################################

# Work out my platform.
if ($^O eq "MSWin32")
{
  $config{'os'} = "windows";
  $config{'editor'} = "notepad";
}
elsif ($^O eq "darwin")
{
  $config{'os'} = "darwin";
  $config{'editor'} = "open";
}
elsif ($^O eq "cygwin")
{
  $config{'os'} = "cygwin";
  $config{'editor'} = "vi";
}
else
{
  $config{'os'} = "unix";
  $config{'editor'} = "nedit";
  $config{'editor_modal'} = "&";
}

# Override editor if present in environment
$config{'editor'} = $ENV{'EDITOR'} || $config{'editor'};

# Read .pmrc file which overrides both defaults and the environment.
if (open(CONFIG, File::Spec->catfile($home, ".pmrc")))
{
  while (<CONFIG>)
  {
    # Comments
    next if /^\s*#/;
    # Blank lines
    next if /^\s*$/;
    
    my ($key, $value) = split("=", $_);
    if ($key && defined($value))
    {
      $config{trim($key)} = trim($value);
    }
    else
    {
      print "Warning: bad config file line: $_\n";
    }
  }
}

# Work out what command I am executing by looking at my executed name
$command = basename($0);

if ($command =~ /^pm(\.pl)?$/i)
{
  # We have been invoked as "pm -<letter>" or "pm --<command>" rather than 
  # via a symlink. So we need to calculate the command to execute from the 
  # first parameter.
  $command = shift @ARGV;
  
  if (defined($command))
  {
    # We need to make the e.g. '-d' or '--diff' match the command names, so
    # cut off initial dashes if present.
    $command =~ s/^--?//;
  }
}
else
{
  # We have been invoked via a symlink. Cut off "pm"
  $command =~ s/^pm//;
}

unless ($command) 
{
  message("No command name given.");
  pmhelp();
  exit;
}

# This command has to be caught before we try and create the data dir.
if ($command eq "init") 
{ 
  pminit(); 
  exit;
}

# Check for existence of datadir.
if (!(-d $config{'datadir'})) 
{
  print "Configured data directory '$config{'datadir'}' does not exist.\n";
  print "(To configure the data directory, edit the script or your .pmrc.)\n";
  print "It needs to exist for Patch Maker to continue.\n";  
  if (ask("Would you like to create it"))
  {
    mkdir($config{'datadir'}, 0755);
  }
  else
  {
    exit;
  }
}

# Which SCM are we using?
if (!$config{'scm'})
{
  $config{'scm'} = "";
  if (-d "CVS") 
  {
    $config{'scm'} = "cvs";
  }
  elsif (-d ".svn") 
  {
    $config{'scm'} = "svn";
  }
  elsif (-d ".bzr") 
  {
    # Note that .bzr only appears at the top level; we may have to recurse
    # upwards
    $config{'scm'} = "bzr";
  }
  elsif (-d ".hg") 
  {
    # Note that .hg only appears at the top level; we may have to recurse
    # upwards
    $config{'scm'} = "hg";
  }
}

###############################################################################
# Hash to map types of SCM to various types of command. It's defined here
# because it depends on various values of $config.
###############################################################################
%scmcommands =
(
  "cvs" => 
    {
      "checkin" => "cvs -z3 -e$config{'editor'} ci",
      "add"     => "cvs -z3 add",
      # Options: show C function, unified, new files are blank
      "diff"    => "cvs diff -$config{'context'} -puN",
      "update"  => "cvs -z3 update",
    },
  "svn" =>
    {
      "checkin" => "svn --editor-cmd $config{'editor'} ci",
      "add"     => "svn add",
      # Options: unified, non-recursive, 10 lines of context (???)
      "diff"    => "svn diff --diff-cmd=\"diff\" -x \"-uN10\"",
      "update"  => "svn update",
    },
  "hg" =>
    {
      # Note: this does a local commit. hg push is required to actually
      # check in changes.
      "checkin" => "hg commit",
      "add"     => "hg add",
      # Options: show C function, 8 lines of context
      "diff"    => "hg diff -p -U8",
      "update"  => "hg pull -u", # Note: only works on entire trees
    },
  "bzr" =>
    {
      # 'checkin' and 'add' haven't been tested yet...
      "checkin" => "EDITOR=$config{'editor'} bzr commit",
      "add"     => "bzr add",
      # Options: Show C function, 8 lines of context
      "diff"    => "bzr diff --diff-options \"-p -U8\"",
      "update"  => "bzr update",
    }
);

# Get the current patch reference
my $patchref_file = get_path("patchref");
  
(open(CURRENT, "<$patchref_file") 
  && ($patchref = <CURRENT>) 
  && close CURRENT)
or $patchref = "_no_patch_reference_";

chomp $patchref;

# Command dispatch
if ($commands{$command})
{
  &{$commands{$command}};
}
else
{
  message("Command '$command' not recognised.");
  message("Try `pm --help' for more information.");
}