source: branches/locker-dev/locker/sbin/commit-email.pl @ 1526

Last change on this file since 1526 was 1414, checked in by ezyang, 15 years ago
Merged in changes from trunk --- Merging r1262 through r1413 into 'deploy/bin': U deploy/bin/django C deploy/bin/rails > Resolved by accepting working copy --- Merging r1221 through r1413 into '.': U sql/bin/get-password U sql/bin/save-password U doc/tickets/rt.txt U doc/tickets/cnames.txt U bin/fix-php-ini C bin/scripts-rails > Resolved by accepting working copy Skipped 'bin/for-each-server' U bin U sbin/parallel-find.pl U sbin/commit-email.pl U sbin/commit-zephyr Summary of conflicts: Tree conflicts: 2 Skipped paths: 1
  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 25.9 KB
RevLine 
[375]1#!/usr/bin/env perl
2
3# ====================================================================
[1414]4# This script is deprecated.  The Subversion developers recommend
5# using mailer.py for post-commit and post-revprop change
6# notifications.  If you wish to improve or add features to a
7# post-commit notification script, please do that work on mailer.py.
8# See http://svn.collab.net/repos/svn/trunk/tools/hook-scripts/mailer .
9# ====================================================================
10
11# ====================================================================
[719]12# commit-email.pl: send a notification email describing either a
13# commit or a revprop-change action on a Subversion repository.
[375]14#
15# For usage, see the usage subroutine or run the script with no
16# command line arguments.
17#
[719]18# This script requires Subversion 1.2.0 or later.
19#
[1414]20# $HeadURL: http://svn.collab.net/repos/svn/trunk/contrib/hook-scripts/commit-email.pl.in $
21# $LastChangedDate: 2009-05-12 13:25:35 -0400 (Tue, 12 May 2009) $
22# $LastChangedBy: blair $
23# $LastChangedRevision: 37715 $
[719]24#
[375]25# ====================================================================
[719]26# Copyright (c) 2000-2006 CollabNet.  All rights reserved.
[375]27#
28# This software is licensed as described in the file COPYING, which
29# you should have received as part of this distribution.  The terms
30# are also available at http://subversion.tigris.org/license-1.html.
31# If newer versions of this license are posted there, you may use a
32# newer version instead, at your option.
33#
34# This software consists of voluntary contributions made by many
35# individuals.  For exact contribution history, see the revision
36# history and logs, available at http://subversion.tigris.org/.
37# ====================================================================
38
39# Turn on warnings the best way depending on the Perl version.
[719]40BEGIN {
41  if ( $] >= 5.006_000)
42    { require warnings; import warnings; }
43  else
44    { $^W = 1; }
45}
46
[375]47use strict;
48use Carp;
[719]49use POSIX qw(strftime);
50my ($sendmail, $smtp_server);
[375]51
52######################################################################
53# Configuration section.
54
[1414]55$ENV{'LC_ALL'} = 'en_US.UTF-8';
56
[719]57# Sendmail path, or SMTP server address.
58# You should define exactly one of these two configuration variables,
59# leaving the other commented out, to select which method of sending
60# email should be used.
61# Using --stdout on the command line overrides both.
62$sendmail = "/usr/sbin/sendmail";
63#$smtp_server = "127.0.0.1";
[375]64
65# Svnlook path.
66my $svnlook = "/usr/bin/svnlook";
67
68# By default, when a file is deleted from the repository, svnlook diff
69# prints the entire contents of the file.  If you want to save space
70# in the log and email messages by not printing the file, then set
71# $no_diff_deleted to 1.
72my $no_diff_deleted = 0;
[719]73# By default, when a file is added to the repository, svnlook diff
74# prints the entire contents of the file.  If you want to save space
75# in the log and email messages by not printing the file, then set
76# $no_diff_added to 1.
77my $no_diff_added = 0;
[375]78
[719]79# End of Configuration section.
80######################################################################
81
82# Check that the required programs exist, and the email sending method
83# configuration is sane, to ensure that the administrator has set up
84# the script properly.
[375]85{
86  my $ok = 1;
87  foreach my $program ($sendmail, $svnlook)
88    {
[719]89      next if not defined $program;
[375]90      if (-e $program)
91        {
92          unless (-x $program)
93            {
94              warn "$0: required program `$program' is not executable, ",
95                   "edit $0.\n";
96              $ok = 0;
97            }
98        }
99      else
100        {
101          warn "$0: required program `$program' does not exist, edit $0.\n";
102          $ok = 0;
103        }
104    }
[719]105  if (not (defined $sendmail xor defined $smtp_server))
106    {
107      warn "$0: exactly one of \$sendmail or \$smtp_server must be ",
108           "set, edit $0.\n";
109      $ok = 0;
110    }
[375]111  exit 1 unless $ok;
112}
113
[719]114require Net::SMTP if defined $smtp_server;
[375]115
116######################################################################
117# Initial setup/command-line handling.
118
119# Each value in this array holds a hash reference which contains the
120# associated email information for one project.  Start with an
121# implicit rule that matches all paths.
122my @project_settings_list = (&new_project);
123
[719]124# Process the command line arguments till there are none left.
125# In commit mode: The first two arguments that are not used by a command line
126# option are the repository path and the revision number.
127# In revprop-change mode: The first four arguments that are not used by a
128# command line option are the repository path, the revision number, the
129# author, and the property name. This script has no support for the fifth
130# argument (action) added to the post-revprop-change hook in Subversion
131# 1.2.0 yet - patches welcome!
[375]132my $repos;
133my $rev;
[719]134my $author;
135my $propname;
[375]136
[719]137my $mode = 'commit';
138my $date;
139my $diff_file;
140
[375]141# Use the reference to the first project to populate.
142my $current_project = $project_settings_list[0];
143
144# This hash matches the command line option to the hash key in the
145# project.  If a key exists but has a false value (''), then the
146# command line option is allowed but requires special handling.
147my %opt_to_hash_key = ('--from' => 'from_address',
[719]148                       '--revprop-change' => '',
149                       '-d'     => '',
[375]150                       '-h'     => 'hostname',
151                       '-l'     => 'log_file',
152                       '-m'     => '',
153                       '-r'     => 'reply_to',
[719]154                       '-s'     => 'subject_prefix',
155                       '--summary' => '',
156                       '--diff' => '',
157                       '--stdout' => '');
[375]158
159while (@ARGV)
160  {
161    my $arg = shift @ARGV;
162    if ($arg =~ /^-/)
163      {
164        my $hash_key = $opt_to_hash_key{$arg};
165        unless (defined $hash_key)
166          {
167            die "$0: command line option `$arg' is not recognized.\n";
168          }
169
[719]170        my $value;
171        if ($arg ne '--revprop-change' and $arg ne '--stdout' and $arg ne '--summary')
[375]172          {
[719]173            unless (@ARGV)
174              {
175                die "$0: command line option `$arg' is missing a value.\n";
176              }
177            $value = shift @ARGV;
[375]178          }
179
180        if ($hash_key)
181          {
182            $current_project->{$hash_key} = $value;
183          }
184        else
185          {
[719]186            if ($arg eq '-m')
[375]187              {
[719]188                $current_project                = &new_project;
189                $current_project->{match_regex} = $value;
190                push(@project_settings_list, $current_project);
[375]191              }
[719]192            elsif ($arg eq '-d')
193              {
194                if ($mode ne 'revprop-change')
195                  {
196                    die "$0: `-d' is valid only when used after"
197                      . " `--revprop-change'.\n";
198                  }
199                if ($diff_file)
200                  {
201                    die "$0: command line option `$arg'"
202                      . " can only be used once.\n";
203                  }
204                $diff_file = $value;
205              }
206            elsif ($arg eq '--revprop-change')
207              {
208                if (defined $repos)
209                  {
210                    die "$0: `--revprop-change' must be specified before"
211                      . " the first non-option argument.\n";
212                  }
213                $mode = 'revprop-change';
214              }
215            elsif ($arg eq '--diff')
216              {
217                $current_project->{show_diff} = parse_boolean($value);
218              }
219            elsif ($arg eq '--stdout')
220              {
221                $current_project->{stdout} = 1;
222              }
223            elsif ($arg eq '--summary')
224              {
225                $current_project->{summary} = 1;
226              }
227            else
228              {
229                die "$0: internal error:"
230                  . " should not be handling `$arg' here.\n";
231              }
[375]232          }
233      }
234    else
235      {
236        if (! defined $repos)
237          {
238            $repos = $arg;
239          }
240        elsif (! defined $rev)
241          {
242            $rev = $arg;
243          }
[719]244        elsif (! defined $author && $mode eq 'revprop-change')
245          {
246            $author = $arg;
247          }
248        elsif (! defined $propname && $mode eq 'revprop-change')
249          {
250            $propname = $arg;
251          }
[375]252        else
253          {
254            push(@{$current_project->{email_addresses}}, $arg);
255          }
256      }
257  }
258
[719]259if ($mode eq 'commit')
260  {
261    &usage("$0: too few arguments.") unless defined $rev;
262  }
263elsif ($mode eq 'revprop-change')
264  {
265    &usage("$0: too few arguments.") unless defined $propname;
266  }
[375]267
268# Check the validity of the command line arguments.  Check that the
269# revision is an integer greater than 0 and that the repository
270# directory exists.
271unless ($rev =~ /^\d+/ and $rev > 0)
272  {
273    &usage("$0: revision number `$rev' must be an integer > 0.");
274  }
275unless (-e $repos)
276  {
277    &usage("$0: repos directory `$repos' does not exist.");
278  }
279unless (-d _)
280  {
281    &usage("$0: repos directory `$repos' is not a directory.");
282  }
283
284# Check that all of the regular expressions can be compiled and
285# compile them.
286{
287  my $ok = 1;
288  for (my $i=0; $i<@project_settings_list; ++$i)
289    {
290      my $match_regex = $project_settings_list[$i]->{match_regex};
291
292      # To help users that automatically write regular expressions
293      # that match the root directory using ^/, remove the / character
294      # because subversion paths, while they start at the root level,
295      # do not begin with a /.
296      $match_regex =~ s#^\^/#^#;
297
298      my $match_re;
299      eval { $match_re = qr/$match_regex/ };
300      if ($@)
301        {
302          warn "$0: -m regex #$i `$match_regex' does not compile:\n$@\n";
303          $ok = 0;
304          next;
305        }
306      $project_settings_list[$i]->{match_re} = $match_re;
307    }
308  exit 1 unless $ok;
309}
310
[719]311# Harvest common data needed for both commit or revprop-change.
[375]312
313# Figure out what directories have changed using svnlook.
[719]314my @dirschanged = &read_from_process($svnlook, 'dirs-changed', $repos,
[375]315                                     '-r', $rev);
316
317# Lose the trailing slash in the directory names if one exists, except
318# in the case of '/'.
319my $rootchanged = 0;
320for (my $i=0; $i<@dirschanged; ++$i)
321  {
322    if ($dirschanged[$i] eq '/')
323      {
324        $rootchanged = 1;
325      }
326    else
327      {
328        $dirschanged[$i] =~ s#^(.+)[/\\]$#$1#;
329      }
330  }
331
332# Figure out what files have changed using svnlook.
[719]333my @svnlooklines = &read_from_process($svnlook, 'changed', $repos, '-r', $rev);
[375]334
335# Parse the changed nodes.
336my @adds;
337my @dels;
338my @mods;
339foreach my $line (@svnlooklines)
340  {
341    my $path = '';
342    my $code = '';
343
344    # Split the line up into the modification code and path, ignoring
345    # property modifications.
346    if ($line =~ /^(.).  (.*)$/)
347      {
348        $code = $1;
349        $path = $2;
350      }
351
352    if ($code eq 'A')
353      {
354        push(@adds, $path);
355      }
356    elsif ($code eq 'D')
357      {
358        push(@dels, $path);
359      }
360    else
361      {
362        push(@mods, $path);
363      }
364  }
365
[719]366# Declare variables which carry information out of the inner scope of
367# the conditional blocks below.
368my $subject_base;
369my $subject_logbase;
370my @body;
371# $author - declared above for use as a command line parameter in
372#   revprop-change mode.  In commit mode, gets filled in below.
[375]373
[719]374if ($mode eq 'commit')
375  {
376    ######################################################################
377    # Harvest data using svnlook.
[375]378
[719]379    # Get the author, date, and log from svnlook.
380    my @infolines = &read_from_process($svnlook, 'info', $repos, '-r', $rev);
381    $author = shift @infolines;
382    $date = shift @infolines;
383    shift @infolines;
384    my @log = map { "$_\n" } @infolines;
385
386    ######################################################################
387    # Modified directory name collapsing.
388
389    # Collapse the list of changed directories only if the root directory
390    # was not modified, because otherwise everything is under root and
391    # there's no point in collapsing the directories, and only if more
392    # than one directory was modified.
393    my $commondir = '';
394    my @edited_dirschanged = @dirschanged;
395    if (!$rootchanged and @edited_dirschanged > 1)
[375]396      {
[719]397        my $firstline    = shift @edited_dirschanged;
398        my @commonpieces = split('/', $firstline);
399        foreach my $line (@edited_dirschanged)
[375]400          {
[719]401            my @pieces = split('/', $line);
402            my $i = 0;
403            while ($i < @pieces and $i < @commonpieces)
[375]404              {
[719]405                if ($pieces[$i] ne $commonpieces[$i])
406                  {
407                    splice(@commonpieces, $i, @commonpieces - $i);
408                    last;
409                  }
410                $i++;
[375]411              }
412          }
[719]413        unshift(@edited_dirschanged, $firstline);
[375]414
[719]415        if (@commonpieces)
[375]416          {
[719]417            $commondir = join('/', @commonpieces);
418            my @new_dirschanged;
419            foreach my $dir (@edited_dirschanged)
[375]420              {
[719]421                if ($dir eq $commondir)
422                  {
423                    $dir = '.';
424                  }
425                else
426                  {
427                    $dir =~ s#^\Q$commondir/\E##;
428                  }
429                push(@new_dirschanged, $dir);
[375]430              }
[719]431            @edited_dirschanged = @new_dirschanged;
[375]432          }
433      }
[719]434    my $dirlist = join(' ', @edited_dirschanged);
[375]435
[719]436    ######################################################################
437    # Assembly of log message.
[375]438
[719]439    if ($commondir ne '')
440      {
441        $subject_base = "r$rev - in $commondir: $dirlist";
442      }
443    else
444      {
445        $subject_base = "r$rev - $dirlist";
446      }
447    my $summary = @log ? $log[0] : '';
448    chomp($summary);
449    $subject_logbase = "r$rev - $summary";
450
451    # Put together the body of the log message.
452    push(@body, "Author: $author\n");
453    push(@body, "Date: $date\n");
454    push(@body, "New Revision: $rev\n");
455    push(@body, "\n");
456    if (@adds)
457      {
458        @adds = sort @adds;
459        push(@body, "Added:\n");
460        push(@body, map { "   $_\n" } @adds);
461      }
462    if (@dels)
463      {
464        @dels = sort @dels;
465        push(@body, "Removed:\n");
466        push(@body, map { "   $_\n" } @dels);
467      }
468    if (@mods)
469      {
470        @mods = sort @mods;
471        push(@body, "Modified:\n");
472        push(@body, map { "   $_\n" } @mods);
473      }
474    push(@body, "Log:\n");
475    push(@body, @log);
476    push(@body, "\n");
[375]477  }
[719]478elsif ($mode eq 'revprop-change')
[375]479  {
[719]480    ######################################################################
481    # Harvest data.
482
483    my @svnlines;
484    # Get the diff file if it was provided, otherwise the property value.
485    if ($diff_file)
486      {
487        open(DIFF_FILE, $diff_file) or die "$0: cannot read `$diff_file': $!\n";
488        @svnlines = <DIFF_FILE>;
489        close DIFF_FILE;
490      }
491    else
492      {
493        @svnlines = &read_from_process($svnlook, 'propget', '--revprop', '-r',
494                                       $rev, $repos, $propname);
495      }
496
497    ######################################################################
498    # Assembly of log message.
499
500    $subject_base = "propchange - r$rev $propname";
501
502    # Put together the body of the log message.
503    push(@body, "Author: $author\n");
504    push(@body, "Revision: $rev\n");
505    push(@body, "Property Name: $propname\n");
506    push(@body, "\n");
507    unless ($diff_file)
508      {
509        push(@body, "New Property Value:\n");
510      }
511    push(@body, map { /[\r\n]+$/ ? $_ : "$_\n" } @svnlines);
512    push(@body, "\n");
[375]513  }
514
[719]515# Cached information - calculated when first needed.
516my @difflines;
517
[375]518# Go through each project and see if there are any matches for this
519# project.  If so, send the log out.
520foreach my $project (@project_settings_list)
521  {
522    my $match_re = $project->{match_re};
523    my $match    = 0;
524    foreach my $path (@dirschanged, @adds, @dels, @mods)
525      {
526        if ($path =~ $match_re)
527          {
528            $match = 1;
529            last;
530          }
531      }
532
533    next unless $match;
534
535    my @email_addresses = @{$project->{email_addresses}};
536    my $userlist        = join(' ', @email_addresses);
537    my $to              = join(', ', @email_addresses);
538    my $from_address    = $project->{from_address};
539    my $hostname        = $project->{hostname};
540    my $log_file        = $project->{log_file};
541    my $reply_to        = $project->{reply_to};
542    my $subject_prefix  = $project->{subject_prefix};
[719]543    my $summary         = $project->{summary};
544    my $diff_wanted     = ($project->{show_diff} and $mode eq 'commit');
545    my $stdout          = $project->{stdout};
[375]546
[719]547    my $subject         = $summary ? $subject_logbase : $subject_base;
[375]548    if ($subject_prefix =~ /\w/)
549      {
550        $subject = "$subject_prefix $subject";
551      }
552    my $mail_from = $author;
553
554    if ($from_address =~ /\w/)
555      {
556        $mail_from = $from_address;
557      }
558    elsif ($hostname =~ /\w/)
559      {
560        $mail_from = "$mail_from\@$hostname";
561      }
[719]562    elsif (defined $smtp_server and ! $stdout)
563      {
564        die "$0: use of either `-h' or `--from' is mandatory when ",
565            "sending email using direct SMTP.\n";
566      }
[375]567
568    my @head;
[719]569    my $formatted_date;
[1414]570    if ($stdout)
[719]571      {
572        $formatted_date = strftime('%a %b %e %X %Y', localtime());
573        push(@head, "From $mail_from $formatted_date\n");
574      }
575    $formatted_date = strftime('%a, %e %b %Y %X %z', localtime());
576    push(@head, "Date: $formatted_date\n");
[375]577    push(@head, "To: $to\n");
578    push(@head, "From: $mail_from\n");
579    push(@head, "Subject: $subject\n");
580    push(@head, "Reply-to: $reply_to\n") if $reply_to;
581
582    ### Below, we set the content-type etc, but see these comments
583    ### from Greg Stein on why this is not a full solution.
584    #
585    # From: Greg Stein <gstein@lyra.org>
586    # Subject: Re: svn commit: rev 2599 - trunk/tools/cgi
587    # To: dev@subversion.tigris.org
588    # Date: Fri, 19 Jul 2002 23:42:32 -0700
[719]589    #
[375]590    # Well... that isn't strictly true. The contents of the files
591    # might not be UTF-8, so the "diff" portion will be hosed.
[719]592    #
[375]593    # If you want a truly "proper" commit message, then you'd use
594    # multipart MIME messages, with each file going into its own part,
595    # and labeled with an appropriate MIME type and charset. Of
596    # course, we haven't defined a charset property yet, but no biggy.
[719]597    #
[375]598    # Going with multipart will surely throw out the notion of "cut
599    # out the patch from the email and apply." But then again: the
600    # commit emailer could see that all portions are in the same
[719]601    # charset and skip the multipart thang.
602    #
[375]603    # etc etc
[719]604    #
[375]605    # Basically: adding/tweaking the content-type is nice, but don't
606    # think that is the proper solution.
607    push(@head, "Content-Type: text/plain; charset=UTF-8\n");
608    push(@head, "Content-Transfer-Encoding: 8bit\n");
609
610    push(@head, "\n");
611
[719]612    if ($diff_wanted and not @difflines)
[375]613      {
[719]614        # Get the diff from svnlook.
615        my @no_diff_deleted = $no_diff_deleted ? ('--no-diff-deleted') : ();
616        my @no_diff_added = $no_diff_added ? ('--no-diff-added') : ();
617        @difflines = &read_from_process($svnlook, 'diff', $repos,
618                                        '-r', $rev, @no_diff_deleted,
619                                        @no_diff_added);
620        @difflines = map { /[\r\n]+$/ ? $_ : "$_\n" } @difflines;
621      }
622
623    if ($stdout)
624      {
625        print @head, @body;
626        print @difflines if $diff_wanted;
627      }
628    elsif (defined $sendmail and @email_addresses)
629      {
[375]630        # Open a pipe to sendmail.
[719]631        my $command = "$sendmail -f'$mail_from' $userlist";
[375]632        if (open(SENDMAIL, "| $command"))
633          {
634            print SENDMAIL @head, @body;
[719]635            print SENDMAIL @difflines if $diff_wanted;
[375]636            close SENDMAIL
637              or warn "$0: error in closing `$command' for writing: $!\n";
638          }
639        else
640          {
641            warn "$0: cannot open `| $command' for writing: $!\n";
642          }
643      }
[719]644    elsif (defined $smtp_server and @email_addresses)
645      {
646        my $smtp = Net::SMTP->new($smtp_server)
647          or die "$0: error opening SMTP session to `$smtp_server': $!\n";
648        handle_smtp_error($smtp, $smtp->mail($mail_from));
649        handle_smtp_error($smtp, $smtp->recipient(@email_addresses));
650        handle_smtp_error($smtp, $smtp->data());
651        handle_smtp_error($smtp, $smtp->datasend(@head, @body));
652        if ($diff_wanted)
653          {
654            handle_smtp_error($smtp, $smtp->datasend(@difflines));
655          }
656        handle_smtp_error($smtp, $smtp->dataend());
657        handle_smtp_error($smtp, $smtp->quit());
658      }
[375]659
660    # Dump the output to logfile (if its name is not empty).
661    if ($log_file =~ /\w/)
662      {
663        if (open(LOGFILE, ">> $log_file"))
664          {
665            print LOGFILE @head, @body;
[719]666            print LOGFILE @difflines if $diff_wanted;
[375]667            close LOGFILE
668              or warn "$0: error in closing `$log_file' for appending: $!\n";
669          }
670        else
671          {
672            warn "$0: cannot open `$log_file' for appending: $!\n";
673          }
674      }
675  }
676
677exit 0;
678
[719]679sub handle_smtp_error
680{
681  my ($smtp, $retval) = @_;
682  if (not $retval)
683    {
684      die "$0: SMTP Error: " . $smtp->message() . "\n";
685    }
686}
687
[375]688sub usage
689{
690  warn "@_\n" if @_;
[719]691  die "usage (commit mode):\n",
692      "  $0 REPOS REVNUM [[-m regex] [options] [email_addr ...]] ...\n",
693      "usage: (revprop-change mode):\n",
694      "  $0 --revprop-change REPOS REVNUM USER PROPNAME [-d diff_file] \\\n",
695      "    [[-m regex] [options] [email_addr ...]] ...\n",
696      "options are:\n",
697      "  -m regex              Regular expression to match committed path\n",
[375]698      "  --from email_address  Email address for 'From:' (overrides -h)\n",
699      "  -h hostname           Hostname to append to author for 'From:'\n",
700      "  -l logfile            Append mail contents to this log file\n",
701      "  -r email_address      Email address for 'Reply-To:'\n",
702      "  -s subject_prefix     Subject line prefix\n",
[719]703      "  --summary             Use first line of commit log in subject\n",
704      "  --diff y|n            Include diff in message (default: y)\n",
705      "                        (applies to commit mode only)\n",
706      "  --stdout              Spit the message in mbox format to stdout.\n",
[375]707      "\n",
708      "This script supports a single repository with multiple projects,\n",
[719]709      "where each project receives email only for actions that affect that\n",
710      "project.  A project is identified by using the -m command line\n".
711      "option with a regular expression argument.  If the given revision\n",
712      "contains modifications to a path that matches the regular\n",
713      "expression, then the action applies to the project.\n",
[375]714      "\n",
[719]715      "Any of the following email addresses and command line options\n",
716      "(other than -d) are associated with this project, until the next -m,\n",
717      "which resets the options and the list of email addresses.\n",
718      "\n",
[375]719      "To support a single project conveniently, the script initializes\n",
720      "itself with an implicit -m . rule that matches any modifications\n",
[719]721      "to the repository.  Therefore, to use the script for a single-\n",
722      "project repository, just use the other command line options and\n",
[375]723      "a list of email addresses on the command line.  If you do not want\n",
[719]724      "a rule that matches the entire repository, then use -m with a\n",
[375]725      "regular expression before any other command line options or email\n",
[719]726      "addresses.\n",
727      "\n",
728      "'revprop-change' mode:\n",
729      "The message will contain a copy of the diff_file if it is provided,\n",
730      "otherwise a copy of the (assumed to be new) property value.\n",
731      "\n";
[375]732}
733
734# Return a new hash data structure for a new empty project that
735# matches any modifications to the repository.
736sub new_project
737{
738  return {email_addresses => [],
739          from_address    => '',
740          hostname        => '',
741          log_file        => '',
742          match_regex     => '.',
743          reply_to        => '',
[719]744          subject_prefix  => '',
745          show_diff       => 1,
746          stdout          => 0};
[375]747}
748
[719]749sub parse_boolean
750{
751  if ($_[0] eq 'y') { return 1; };
752  if ($_[0] eq 'n') { return 0; };
753
754  die "$0: valid boolean options are 'y' or 'n', not '$_[0]'\n";
755}
756
[375]757# Start a child process safely without using /bin/sh.
758sub safe_read_from_pipe
759{
760  unless (@_)
761    {
762      croak "$0: safe_read_from_pipe passed no arguments.\n";
763    }
764
[1414]765  my $openfork_available = $^O ne "MSWin32";
[719]766  if ($openfork_available) # We can fork on this system.
[375]767    {
[719]768      my $pid = open(SAFE_READ, '-|');
769      unless (defined $pid)
770        {
771          die "$0: cannot fork: $!\n";
772        }
773      unless ($pid)
774        {
775          open(STDERR, ">&STDOUT")
776            or die "$0: cannot dup STDOUT: $!\n";
777          exec(@_)
778            or die "$0: cannot exec `@_': $!\n";
779        }
[375]780    }
[1414]781  else  # Running on Windows.  No fork.
[375]782    {
[719]783      my @commandline = ();
784      my $arg;
[1414]785
[719]786      while ($arg = shift)
787        {
788          $arg =~ s/\"/\\\"/g;
789          if ($arg eq "" or $arg =~ /\s/) { $arg = "\"$arg\""; }
790          push(@commandline, $arg);
791        }
[1414]792
[719]793      # Now do the pipe.
794      open(SAFE_READ, "@commandline |")
795        or die "$0: cannot pipe to command: $!\n";
[375]796    }
797  my @output;
798  while (<SAFE_READ>)
799    {
800      s/[\r\n]+$//;
801      push(@output, $_);
802    }
803  close(SAFE_READ);
804  my $result = $?;
805  my $exit   = $result >> 8;
806  my $signal = $result & 127;
807  my $cd     = $result & 128 ? "with core dump" : "";
808  if ($signal or $cd)
809    {
810      warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
811    }
812  if (wantarray)
813    {
814      return ($result, @output);
815    }
816  else
817    {
818      return $result;
819    }
820}
821
822# Use safe_read_from_pipe to start a child process safely and return
823# the output if it succeeded or an error message followed by the output
824# if it failed.
825sub read_from_process
826{
827  unless (@_)
828    {
829      croak "$0: read_from_process passed no arguments.\n";
830    }
831  my ($status, @output) = &safe_read_from_pipe(@_);
832  if ($status)
833    {
834      return ("$0: `@_' failed with this output:", @output);
835    }
836  else
837    {
838      return @output;
839    }
840}
Note: See TracBrowser for help on using the repository browser.