#!/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 Manager.
#
# The Initial Developer of the Original Code is
# Gervase Markham <gerv@mozilla.org>.
# Portions created by the Initial Developer are Copyright (C) 2001
# the Initial Developer. All Rights Reserved.
#
# Contributor(s):
#
# 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.
#
# ----- END LICENSE BLOCK -----
##############################################################################

##############################################################################
# This is version 1.1 of Patch Manager.
# Patch Manager currently requires the following external programs: 
# unzip, touch, grep
#
# It also requires a file called chromelist.txt, which is a list of all the
# editable files in the chrome, in local form, and their equivalent CVS paths.
##############################################################################

##############################################################################
# Terminology:
# CVS files    = files in your cvs tree
# Build files  = their equivalents in a built version of the app
# 'Files' file = the file with a ".file" extension in your data directory
#                which contains the list of CVS files and Build files
# patch reference (or patchref) = the tag used to identify the current patch.
#                You can also give patches a "title" in their Files file.
# setpath      = Path to your installed stuff directory (chrome directory).
##############################################################################

##############################################################################
#
# Configuration - fill in your values here.
#
##############################################################################
# datadir - where Patch Manager keeps its files.
# must exist. "~" doesn't work. <shrug>
my $datadir = "/home/gerv/pm";

my $editor = "nedit";

# A string to be passed to cvs's "-d" option when doing checkins
# This is good if you work normally with cvs-mirror but want to check in
# to cvs. If you don't check in, you can leave this.
my $cvsroot = ':pserver:gerv%gerv.net@cvs.mozilla.org:/cvsroot';

# If you are using Mozilla and set up normally, you can leave $executable.
my $executable = "../mozilla";       # relative to the setpath

# Whether you have a permanent net connection
my $work_online = 0;

##############################################################################
#
# Subroutines
#
##############################################################################

##############################################################################
# Return the CVS files and the corresponding Build files as a hash
##############################################################################
sub get_files()
{
  my @cvsfiles = get_cvs_files_list();
  
  open(FILELIST, "<$datadir/$patchref.files")
                      or die "$execname: Can't open file `$patchref.files'.\n";
  # Skip past first section
  while (<FILELIST>) 
  {
    last if /---/;  # first separator
  }

  my @buildfiles;
  while (<FILELIST>) 
  {
    chomp;
    next if /^\s*#/; # comments
    next if /^$/;
    last if /---/;   # second separator
    s/^\s+//;        # remove leading whitespace
    s/\s+$//;        # remove trailing whitespace
    push @buildfiles, $_;
  }
  close FILELIST;
  
  if (scalar(@cvsfiles) < scalar(@buildfiles))
  {
    # We can have more in the first than the second; they just don't get copied
    # anywhere.
    print "Warning: more files in second section of list than first.\n";
    print "Nothing will be copied to the excess locations.\n";
  }
  
  my %files;
  
  foreach $cvsfile (@cvsfiles)
  {
    $files{$cvsfile} = shift @buildfiles;
  }
  
  return %files;
}

##############################################################################
# Return the CVS files as an array or a space-separated list
##############################################################################
sub get_cvs_files_list()
{
  open(FILELIST, "<$datadir/$patchref.files")
                      or die "$execname: Can't open file `$patchref.files'.\n";
  my @cvsfiles;
  while (<FILELIST>) 
  {
    chomp;
    last if /---/;   # the first separator
    next if /^\s*#/; # comments
    next if /^$/;
    s/^\s+//;        # remove leading whitespace
    s/\s+$//;        # remove trailing whitespace
    push @cvsfiles, $_;
  }
  close FILELIST;
  
  if (wantarray)
  {
    return @cvsfiles;  
  }
  else
  {
    my $files = join " ", @cvsfiles;
    return $files;
  }
}

##############################################################################
# Print and run a given command line.
##############################################################################
sub pexec( $ )
{
  my ($exec) = @_;
  print $exec . "\n";
  system $exec;
}
  
##############################################################################
# "files" file template.
# This is split into three to allow insertion of initial values on creation,
# if the user has imported a patch.
##############################################################################

my $template1 = <<ENDOFTEMPLATE1;
# Title: 
#
# CVS file locations go after this line.
ENDOFTEMPLATE1

my $template2 = <<ENDOFTEMPLATE2;

--- separator ---
# installed file locations (or /dev/null) go after this line, in 1:1 
# correspondence with the above.

ENDOFTEMPLATE2

my $template3 = <<ENDOFTEMPLATE3;
--- separator ---
# Implementation notes and other jottings go here.
# This part isn't parsed.

ENDOFTEMPLATE3

##############################################################################
#
# Functions implementing Patch Manager commands
#
##############################################################################

##############################################################################
# Add
##############################################################################
sub pmadd()
{
  my $fileslist = get_cvs_files_list();
  pexec("cvs -d$cvsroot -z3 add $fileslist"); 
}

##############################################################################
# Checkin
##############################################################################
sub pmcheckin()
{
  # All other args to pmcheckin get passed to cvs as post-mode commands.
  # Good for checking in on branches.
  my $args = join ' ', @ARGV;

  # We need to be really sure we know what we are doing here...
  pmwhoami();
  pmupdate();
  pmdiff();
  pmview();
  
  print "\n*** Have you made sure that the tree is green and open? ***\n\n";
  print "Are you sure you want to check in? Type 'yes' to continue: ";
  if (<STDIN> eq "yes\n")
  {
    my $fileslist = get_cvs_files_list();
    pexec("cvs -d$cvsroot -z3 -e$editor ci $args " . $fileslist); 
  }    
  else
  {
    print ("Checkin aborted.\n");
  }
}

##############################################################################
# Copy
##############################################################################
sub pmcopy()
{
  # Get the current buildpath
  open(BUILDPATH, "<$datadir/buildpath") 
                            or die "$execname: Can't open file `buildpath'.\n";
  $buildpath = <BUILDPATH>;
  close BUILDPATH;
  chomp $buildpath;

  # We force a copy of all files on -f or if we haven't copied this patch
  # before.
  my $force;
  my $arg = shift @ARGV || "";
  if ($arg eq "-f" || (!(-e "$buildpath/$patchref.copied")))
  {
    $force = 1;
  }
  
  %files = get_files();

  foreach $cvsfile (keys %files)
  {
    $buildfile = $files{$cvsfile};
  
    # You can have less buildfiles than cvsfiles; the excess just don't
    # get copied.
    if (!$buildfile || $buildfile eq "/dev/null")
    {
      print "Not copying $cvsfile - no destination specified.\n";
      next;
    }
    
    # Make sure the files exist, otherwise the user has probably got their
    # files list wrong.
    if    (!(-e $cvsfile))
    {
      print " Warning: $cvsfile does not exist.\n";
    }    
    elsif (!(-e "$buildpath/$buildfile"))
    {
      print " Warning: $buildpath/$buildfile does not exist. Copy anyway? [y] ";
      $input = <STDIN>;
      chomp $input;
      if ($input eq "y" || $input eq "")
      {
        pexec("cp $cvsfile $buildpath/$buildfile");
      }    
    }
    elsif ((-M "$cvsfile" < -M "$buildpath/$buildfile") || $force)
    {
      # Only copy across if the file has changed or we are forced
      pexec("cp $cvsfile $buildpath/$buildfile");
    }
  }
  
  system("touch $buildpath/$patchref.copied");
}

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

  # Back up the old diff
  system "touch $datadir/$patchref.diff";
  system "mv $datadir/$patchref.diff $datadir/$patchref.bak";
  
  my $files = get_cvs_files_list();
  
  if ($files eq "")
  {
    # Avoid running a cvs diff on the entire Mozilla tree
    print "$execname: No files in the file list to diff.\n";
    exit;
  }
  
  # Create the new one
  pexec("cvs diff -uN $args $files > $datadir/$patchref.diff\n");

  # 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. Otherwise,
  # print size info and clear up.
  if (-s "$datadir/$patchref.diff")
  {
    print "Patch size is ";
    print -s "$datadir/$patchref.diff";
    print " bytes\n";
    system "rm $datadir/$patchref.bak";
  }
  else
  {
    print "\n*** Warning: diff has zero size. Not overwriting. ***\n\n";
    system "mv $datadir/$patchref.bak $datadir/$patchref.diff";
    return 0;
  }
  
  return 1;
}

##############################################################################
# Edit
##############################################################################
sub pmedit()
{
  my @cvsfiles = get_cvs_files_list();
  my $editfiles = "";
  
  # Arguments to pmedit are interpreted as globs of files in the list -
  # e.g. pmedit *.cpp . 
  my $regexp = shift @ARGV || "";

  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 syntax.
      $regexp =~ tr/.?/\../;
      $regexp =~ s/\*/.\*/;

      foreach $file (@cvsfiles)
      {
        if($file =~ /$regexp/)
        {
          $editfiles = $editfiles . $file . " ";
        }
      }
      
      $regexp = shift @ARGV || "";
    }
  }
  else
  {
    # No glob - just open the lot
    $editfiles = join(' ', @cvsfiles);
  }
    
  if ($editfiles eq "")
  {
    print "$execname: No filenames match the string given.\n";
    exit;
  }
  else
  {
    $editfiles =~ s/\s+$//;
    pexec("$editor $editfiles &");
  }
}

##############################################################################
# Flist
##############################################################################
sub pmflist()
{
  if (!(-e "$datadir/$patchref.files")) 
  {
    my @matches;

    open(FILELIST, ">$datadir/$patchref.files") 
                      or die "$execname: Can't open file `$patchref.files'.\n";
    print FILELIST $template1;                                     

    if (-e "$datadir/$patchref.diff")
    {
      # If there is a .diff, then we've got the patch from elsewhere. So, we
      # need to parse the patch file to get all the filenames. Saves effort. 
      
      # Get the current buildpath
      open(BUILDPATH, "<$datadir/buildpath") 
                            or die "$execname: Can't open file `buildpath'.\n";
      $buildpath = <BUILDPATH>;
      close BUILDPATH;
      chomp $buildpath;
      chdir $buildpath; # for the "find" command
      
      open(DIFF, "<$datadir/$patchref.diff");
      while (<DIFF>)
      {
        if (/Index: (.*)/)
        {
          print FILELIST $1 . "\n";
          
          # We work out the filename and try and track it down in the
          # build area. Again, saves effort.
          $1 =~ /.*\/(.*)/;  
          push @matches, `find . -name $1`;
        }
      }
      
    }      
     
    print FILELIST $template2;                                           
    print FILELIST join("", @matches);
    print FILELIST $template3;
    close FILELIST;
    
    pmmatch();
  }
  
  pexec("$editor $datadir/$patchref.files &");
}

##############################################################################
# Grep
##############################################################################
sub pmgrep()
{
  my $fileslist = get_cvs_files_list();
  # Don't print the command
  system("grep \"$ARGV[0]\" $fileslist"); 
}

##############################################################################
# Match
##############################################################################
sub pmmatch()
{
  # Get the current buildpath
  open(BUILDPATH, "<$datadir/buildpath") 
                            or die "$execname: Can't open file `buildpath'.\n";
  $buildpath = <BUILDPATH>;
  close BUILDPATH;
  chomp $buildpath;
  chdir $buildpath; # for the "find" command
      
  my @cvsfiles = get_cvs_files_list();
  
  foreach $cvsfile (@cvsfiles)
  {
    $cvsfile =~ /.*\/(.*)/;
    print `find . -name $1`;
  }
}

##############################################################################
# Patch
##############################################################################
sub pmpatch( $ )
{
  # All extra args to pmpatch get passed to patch. The most common one to use
  # in this context is -R.
  $args = join(' ', @ARGV) . join(' ', @_);
  $args =~ s/\s+$//;
  
  my $dopatch = 1;
  
  # If we are given -R, we are backing out the patch. If that's the case,
  # we need to be certain that the patch is up-to-date, or really horrible
  # partially-backed-out things happen which take ages to fix.
  if ($args eq "-R")
  {
    # Empty ARGV
    shift @ARGV;
    $dopatch = pmdiff();
  }
  
  # If the diff was zero size, the patch is already backed out
  if ($dopatch)
  {
    pexec("patch -p0 $args < $datadir/$patchref.diff");
  }
}

##############################################################################
# Query
##############################################################################
sub pmquery()
{
  my $currentpatchfile;
  if ($ARGV[0])
  {  
    # set up argv with all files in the current patch
    # if query is "current".
    if ($ARGV[0] eq "current")
    {
      @ARGV = get_cvs_files_list();
      $currentpatchfile = "$datadir/$patchref.files";
    }
  }
  else
  {
    print "No query string given.\n";
    exit;
  }
  
  # Each command-line argument is a query parameter
  while ($query = shift @ARGV)
  {
    # Convert glob syntax to regexp syntax.
    $query =~ tr/.?/\../;
    $query =~ s/\*/.\*/;
    
    my @files = <$datadir/*.files>;

    foreach $file (@files)
    {
      # If we are doing a "current" query, don't do the current patch file
      next if $currentpatchfile && ($file eq $currentpatchfile);
      
      $file =~ /$datadir\/(.*).files/;
      $patchref = $1;
      my @cvsfiles = get_cvs_files_list();

      foreach $cvsfile (@cvsfiles)
      {
        if ($cvsfile =~ /$query/)
        {
          my $firstline;

          if (open(FILELIST, "<$datadir/$patchref.files"))
          {
            $firstline = <FILELIST>;
            close FILELIST;    
          }

          print ("'" . $patchref . "'");
          if ($firstline && $firstline =~ /Title:\s+(.*)$/i)                                 
          {
            print " - \"" . $1 . "\"";
          }

          print ("\n uses \"" . $cvsfile . "\"\n");
        }
      }    
    }
  }
}

##############################################################################
# Run
##############################################################################
sub pmrun()
{
  # All other args to pmrun get passed to the app
  my $args = join ' ', @ARGV;

  # Sync versions if necessary
  pmcopy();
  
  # Get the current buildpath
  open(BUILDPATH, "<$datadir/buildpath") 
                            or die "$execname: Can't open file `buildpath'.\n";
  $buildpath = <BUILDPATH>;
  close BUILDPATH;
  chomp $buildpath;

  # Run the executable.
  system("$buildpath/$executable $args");
}

##############################################################################
# Setpath
##############################################################################
sub pmsetpath()
{
  my $newpath = shift @ARGV;
  
  if (!$newpath)
  {
     print "$execname: No new path given.\n";
     exit;
  }
  
  # ditch trailing /, if present
  if ($newpath =~ /\/$/)
  {
    chop $newpath;
  } 

  open(BUILDPATH, ">$datadir/buildpath") 
                            or die "$execname: Can't open file `buildpath'.\n";
  print BUILDPATH $newpath;                                     
  close BUILDPATH;
  
  # A few Mozilla-specific warnings.
  if ($newpath =~ /mozilla/ && !($newpath =~ /chrome$/))
  {
    print "For optimum results, include the chrome dir in the path...\n";
  }
  
  # Mozilla-specific: unjar chrome if necessary.
  # We make the test complex to avoid potential problems using pm with other
  # apps.
  if (!(-d "$newpath/navigator") && ($newpath =~ /chrome$/))
  {
    print "Unjarring chrome...";
    chdir $newpath;
    while (<*.jar>)
    {
      system("unzip $_");
      print ".";
    }

    print "\n";
    
    # Fix up installed-chrome.txt
    local $^I = ".orig";
    local @ARGV = ("installed-chrome.txt");
    while (<>)
    {
      s/chrome\/.*jar!/chrome/g;
      s/jar://g;
      print;
    }    
  }
}

##############################################################################
# Switch
##############################################################################
sub pmswitch()
{
  # Do we have an argument? 
  $patchref = shift @ARGV;
  if ($patchref)
  {
    open(CURRENT, ">$datadir/patchref") 
                             or die "$execname: Can't open file `patchref'.\n";
    print CURRENT $patchref;
    print "You are now working on patch `$patchref'\n";       
    close CURRENT;

    # You always want to do these things, and it's easy to forget, so they are
    # done for you. You are then immediately aware of any conflicts.
    if ($work_online && -e "$datadir/$patchref.diff") 
    {
        print "CVS updating the relevant files...\n";
        pmupdate();
        print "Applying saved patch from previous session...\n";
        # If the patch is already in, we just ignore the problems 
        # and do nothing.
        pmpatch("-N");
    }
  }
  else
  {
    print "$execname: No new patch reference given.\n";
    exit;
  }
}

##############################################################################
# Update
##############################################################################
sub pmupdate()
{
  # All other args to pmupdate get passed to cvs as post-mode commands.
  # Good for checking in on branches.
  my $args = join ' ', @ARGV;
  
  my $fileslist = get_cvs_files_list();
  
  pexec("cvs -z3 update $args $fileslist");
}

##############################################################################
# View
##############################################################################
sub pmview()
{
  my $file = shift @ARGV || $patchref;
  
  pexec("$editor $datadir/$file.diff &");
}

##############################################################################
# Whoami
##############################################################################
sub pmwhoami()
{
  print "You are currently working on `$patchref'\n";

  if (open(FILELIST, "<$datadir/$patchref.files"))
  {
    my $firstline = <FILELIST>;
    if ($firstline =~ /Title:\s*(.*)$/i && $1)                                 
    {
      print "\"" . $1 . "\"\n";
    }
    close FILELIST;    
  }
}


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

# Work out what command I am executing by looking at my executed name
$0 =~ /.*\/(.*)/;
$execname = $1;
$command = $1;

if ($command eq "pm")
{
  # 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;
  
  # We need to make the -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//;
}

if (!$command)
{
  print "$execname: No command name given.\n";
  exit;
}

# Get the current patch reference (always needed)
open(CURRENT, "<$datadir/patchref") 
                             or die "$execname: Can't open file `patchref'.\n";
$patchref = <CURRENT>;
close CURRENT;
chomp $patchref;

# Execute the correct command.
if    ($command eq "add"     || $command eq "a")
{ pmadd(); }
elsif ($command eq "copy"    || $command eq "c")
{ pmcopy(); }
elsif ($command eq "diff"    || $command eq "d")
{ pmdiff(); }
elsif ($command eq "edit"    || $command eq "e")
{ pmedit(); }
elsif ($command eq "flist"   || $command eq "f")
{ pmflist(); }
elsif ($command eq "grep"    || $command eq "g")
{ pmgrep(); }
elsif ($command eq "checkin" || $command eq "i")
{ pmcheckin(); }
elsif ($command eq "match"   || $command eq "m")
{ pmmatch(); }
elsif ($command eq "patch"   || $command eq "p")
{ pmpatch(""); }  
elsif ($command eq "query"   || $command eq "q")
{ pmquery(); }
elsif ($command eq "run"     || $command eq "r")
{ pmrun(); }
elsif ($command eq "switch"  || $command eq "s")
{ pmswitch(); }
elsif ($command eq "setpath" || $command eq "sp")
{ pmsetpath(); }
elsif ($command eq "update"  || $command eq "u")
{ pmupdate(); }
elsif ($command eq "view"    || $command eq "v")
{ pmview(); }
elsif ($command eq "whoami"  || $command eq "w")
{ pmwhoami(); }
else
{ 
  print "$execname: Command not recognised.\n"; 
}

exit;