propchange-email.pl.in

linux subdivision ying gai ke yi le ba

#!/usr/bin/env perl

# ====================================================================
# propchange-email.pl: send a commit email containing the new value of
# revision property PROPNAME in revision REV of repository REPOS to
# some email addresses.
#
# For usage, see the usage subroutine or run the script with no
# command line arguments.
#
# $HeadURL: http://svn.collab.net/repos/svn/branches/1.1.x/tools/hook-scripts/propchange-email.pl.in $
# $LastChangedDate: 2004-06-14 13:29:22 -0700 (Mon, 14 Jun 2004) $
# $LastChangedBy: breser $
# $LastChangedRevision: 9986 $
#    
# ====================================================================
# Copyright (c) 2000-2004 CollabNet.  All rights reserved.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution.  The terms
# are also available at http://subversion.tigris.org/license-1.html.
# If newer versions of this license are posted there, you may use a
# newer version instead, at your option.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://subversion.tigris.org/.
# ====================================================================

# Turn on warnings the best way depending on the Perl version.
BEGIN {
  if ( $] >= 5.006_000)
    { require warnings; import warnings; }                      
  else  
    { $^W = 1; }               
}           

use strict;
use Carp;
use Cwd 'abs_path';

######################################################################
# Configuration section.

# Sendmail path.
my $sendmail = "/usr/sbin/sendmail";

# Svnlook path.
my $svnlook = "@SVN_BINDIR@/svnlook";

# Svn path.
my $svn = "@SVN_BINDIR@/svn";

# Since the path to svn depends upon the local installation
# preferences, check that the required programs exist to insure that
# the administrator has set up the script properly.
{
  my $ok = 1;
  foreach my $program ($sendmail, $svnlook, $svn)
    {
      if (-e $program)
        {
          unless (-x $program)
            {
              warn "$0: required program `$program' is not executable, ",
                   "edit $0.\n";
              $ok = 0;
            }
        }
      else
        {
          warn "$0: required program `$program' does not exist, edit $0.\n";
          $ok = 0;
        }
    }
  exit 1 unless $ok;
}


######################################################################
# Initial setup/command-line handling.

# Each value in this array holds a hash reference which contains the
# associated email information for one project.  Start with an
# implicit rule that matches all paths.
my @project_settings_list = (&new_project);

# Process the command line arguments till there are none left.  The
# first four arguments that are not used by a command line option are
# the repository path, the revision number, the author, and the property name.
my $repos;
my $rev;
my $author;
my $propname;
my $diff_file;

# Use the reference to the first project to populate.
my $current_project = $project_settings_list[0];

# This hash matches the command line option to the hash key in the
# project.  If a key exists but has a false value (''), then the
# command line option is allowed but requires special handling.
my %opt_to_hash_key = ('--from' => 'from_address',
                       '-d'     => '',
                       '-h'     => 'hostname',
                       '-l'     => 'log_file',
                       '-m'     => '',
                       '-r'     => 'reply_to',
                       '-s'     => 'subject_prefix');

while (@ARGV)
  {
    my $arg = shift @ARGV;
    if ($arg =~ /^-/)
      {
        my $hash_key = $opt_to_hash_key{$arg};
        unless (defined $hash_key)
          {
            die "$0: command line option `$arg' is not recognized.\n";
          }

        unless (@ARGV)
          {
            die "$0: command line option `$arg' is missing a value.\n";
          }
        my $value = shift @ARGV;

        if ($hash_key)
          {
            $current_project->{$hash_key} = $value;
          }
        else
          {
            # Here handle -m.
            if ($arg eq '-m')
              {
                $current_project                = &new_project;
                $current_project->{match_regex} = $value;
                push(@project_settings_list, $current_project);
              }
            elsif ($arg eq '-d')
              {
                if ($diff_file)
                  {
                    die "$0: command line option `$arg' can only be used once.\n";
                  }
                $diff_file = $value;
              }
            else
              {
                die "$0: internal error: should not be handling `$arg' here.\n";
              }
          }
      }
    elsif ($arg =~ /^-/)
      {
        die "$0: command line option `$arg' is not recognized.\n";
      }
    else
      {
        if (! defined $repos)
          {
            $repos = $arg;
          }
        elsif (! defined $rev)
          {
            $rev = $arg;
          }
        elsif (! defined $author)
          {
            $author = $arg;
          }
        elsif (! defined $propname)
          {
            $propname = $arg;
          }
        else
          {
            push(@{$current_project->{email_addresses}}, $arg);
          }
      }
  }

# If the property name is undefined, then there were not enough
# command line arguments.
&usage("$0: too few arguments.") unless defined $propname;

# Check the validity of the command line arguments.  Check that the
# revision is an integer greater than 0 and that the repository
# directory exists.
unless ($rev =~ /^\d+/ and $rev > 0)
  {
    &usage("$0: revision number `$rev' must be an integer > 0.");
  }
unless (-e $repos)
  {
    &usage("$0: repos directory `$repos' does not exist.");
  }
unless (-d _)
  {
    &usage("$0: repos directory `$repos' is not a directory.");
  }

# Check that all of the regular expressions can be compiled and
# compile them.
{
  my $ok = 1;
  for (my $i=0; $i<@project_settings_list; ++$i)
    {
      my $match_regex = $project_settings_list[$i]->{match_regex};

      # To help users that automatically write regular expressions
      # that match the root directory using ^/, remove the / character
      # because subversion paths, while they start at the root level,
      # do not begin with a /.
      $match_regex =~ s#^\^/#^#;

      my $match_re;
      eval { $match_re = qr/$match_regex/ };
      if ($@)
        {
          warn "$0: -m regex #$i `$match_regex' does not compile:\n$@\n";
          $ok = 0;
          next;
        }
      $project_settings_list[$i]->{match_re} = $match_re;
    }
  exit 1 unless $ok;
}

######################################################################
# Harvest data.

my @svnlines;
# Get the diff file if it was provided, otherwise the property value.
if ($diff_file)
  {
    open(DIFF_FILE, $diff_file) or die "$0: cannot read `$diff_file': $!\n";
    @svnlines = <DIFF_FILE>;
    close DIFF_FILE;
  }
else
  {
    # Get the property value using svn.
    my $repos_url = 'file://' . &abs_path($repos);
    @svnlines = &read_from_process($svn, 'propget', '--revprop', '-r', $rev, 
                                      $propname, $repos_url);
  }