Index: locker/sbin/commit-email.pl
===================================================================
--- locker/sbin/commit-email.pl	(revision 375)
+++ locker/sbin/commit-email.pl	(revision 719)
@@ -2,17 +2,19 @@
 
 # ====================================================================
-# commit-email.pl: send a commit email for commit REVISION in
-# repository REPOS to some email addresses.
+# commit-email.pl: send a notification email describing either a
+# commit or a revprop-change action on a Subversion repository.
 #
 # For usage, see the usage subroutine or run the script with no
 # command line arguments.
 #
-# $HeadURL$
-# $LastChangedDate$
-# $LastChangedBy$
-# $LastChangedRevision$
-#    
+# This script requires Subversion 1.2.0 or later.
+#
+# $HeadURL: http://svn.collab.net/repos/svn/trunk/tools/hook-scripts/commit-email.pl.in $
+# $LastChangedDate: 2008-04-01 13:19:34 -0400 (Tue, 01 Apr 2008) $
+# $LastChangedBy: glasser $
+# $LastChangedRevision: 30158 $
+#
 # ====================================================================
-# Copyright (c) 2000-2004 CollabNet.  All rights reserved.
+# Copyright (c) 2000-2006 CollabNet.  All rights reserved.
 #
 # This software is licensed as described in the file COPYING, which
@@ -28,19 +30,26 @@
 
 # Turn on warnings the best way depending on the Perl version.
-BEGIN {                                                                         
-  if ( $] >= 5.006_000)                                                         
-    { require warnings; import warnings; }                
-  else                                                                          
-    { $^W = 1; }                                                  
-}                                                                               
-						
+BEGIN {
+  if ( $] >= 5.006_000)
+    { require warnings; import warnings; }
+  else
+    { $^W = 1; }
+}
+
 use strict;
 use Carp;
+use POSIX qw(strftime);
+my ($sendmail, $smtp_server);
 
 ######################################################################
 # Configuration section.
 
-# Sendmail path.
-my $sendmail = "/usr/sbin/sendmail";
+# Sendmail path, or SMTP server address.
+# You should define exactly one of these two configuration variables,
+# leaving the other commented out, to select which method of sending
+# email should be used.
+# Using --stdout on the command line overrides both.
+$sendmail = "/usr/sbin/sendmail";
+#$smtp_server = "127.0.0.1";
 
 # Svnlook path.
@@ -52,12 +61,21 @@
 # $no_diff_deleted to 1.
 my $no_diff_deleted = 0;
-
-# Since the path to svnlook depends upon the local installation
-# preferences, check that the required programs exist to insure that
-# the administrator has set up the script properly.
+# By default, when a file is added to the repository, svnlook diff
+# prints the entire contents of the file.  If you want to save space
+# in the log and email messages by not printing the file, then set
+# $no_diff_added to 1.
+my $no_diff_added = 0;
+
+# End of Configuration section.
+######################################################################
+
+# Check that the required programs exist, and the email sending method
+# configuration is sane, to ensure that the administrator has set up
+# the script properly.
 {
   my $ok = 1;
   foreach my $program ($sendmail, $svnlook)
     {
+      next if not defined $program;
       if (-e $program)
         {
@@ -75,7 +93,14 @@
         }
     }
+  if (not (defined $sendmail xor defined $smtp_server))
+    {
+      warn "$0: exactly one of \$sendmail or \$smtp_server must be ",
+           "set, edit $0.\n";
+      $ok = 0;
+    }
   exit 1 unless $ok;
 }
 
+require Net::SMTP if defined $smtp_server;
 
 ######################################################################
@@ -87,9 +112,20 @@
 my @project_settings_list = (&new_project);
 
-# Process the command line arguments till there are none left.  The
-# first two arguments that are not used by a command line option are
-# the repository path and the revision number.
+# Process the command line arguments till there are none left.
+# In commit mode: The first two arguments that are not used by a command line
+# option are the repository path and the revision number.
+# In revprop-change mode: 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. This script has no support for the fifth
+# argument (action) added to the post-revprop-change hook in Subversion
+# 1.2.0 yet - patches welcome!
 my $repos;
 my $rev;
+my $author;
+my $propname;
+
+my $mode = 'commit';
+my $date;
+my $diff_file;
 
 # Use the reference to the first project to populate.
@@ -100,9 +136,14 @@
 # command line option is allowed but requires special handling.
 my %opt_to_hash_key = ('--from' => 'from_address',
+                       '--revprop-change' => '',
+                       '-d'     => '',
                        '-h'     => 'hostname',
                        '-l'     => 'log_file',
                        '-m'     => '',
                        '-r'     => 'reply_to',
-                       '-s'     => 'subject_prefix');
+                       '-s'     => 'subject_prefix',
+                       '--summary' => '',
+                       '--diff' => '',
+                       '--stdout' => '');
 
 while (@ARGV)
@@ -117,9 +158,13 @@
           }
 
-        unless (@ARGV)
-          {
-            die "$0: command line option `$arg' is missing a value.\n";
-          }
-        my $value = shift @ARGV;
+        my $value;
+        if ($arg ne '--revprop-change' and $arg ne '--stdout' and $arg ne '--summary')
+          {
+            unless (@ARGV)
+              {
+                die "$0: command line option `$arg' is missing a value.\n";
+              }
+            $value = shift @ARGV;
+          }
 
         if ($hash_key)
@@ -129,17 +174,51 @@
         else
           {
-            # Here handle -m.
-            unless ($arg eq '-m')
-              {
-                die "$0: internal error: should only handle -m here.\n";
-              }
-            $current_project                = &new_project;
-            $current_project->{match_regex} = $value;
-            push(@project_settings_list, $current_project);
-          }
-      }
-    elsif ($arg =~ /^-/)
-      {
-        die "$0: command line option `$arg' is not recognized.\n";
+            if ($arg eq '-m')
+              {
+                $current_project                = &new_project;
+                $current_project->{match_regex} = $value;
+                push(@project_settings_list, $current_project);
+              }
+            elsif ($arg eq '-d')
+              {
+                if ($mode ne 'revprop-change')
+                  {
+                    die "$0: `-d' is valid only when used after"
+                      . " `--revprop-change'.\n";
+                  }
+                if ($diff_file)
+                  {
+                    die "$0: command line option `$arg'"
+                      . " can only be used once.\n";
+                  }
+                $diff_file = $value;
+              }
+            elsif ($arg eq '--revprop-change')
+              {
+                if (defined $repos)
+                  {
+                    die "$0: `--revprop-change' must be specified before"
+                      . " the first non-option argument.\n";
+                  }
+                $mode = 'revprop-change';
+              }
+            elsif ($arg eq '--diff')
+              {
+                $current_project->{show_diff} = parse_boolean($value);
+              }
+            elsif ($arg eq '--stdout')
+              {
+                $current_project->{stdout} = 1;
+              }
+            elsif ($arg eq '--summary')
+              {
+                $current_project->{summary} = 1;
+              }
+            else
+              {
+                die "$0: internal error:"
+                  . " should not be handling `$arg' here.\n";
+              }
+          }
       }
     else
@@ -153,4 +232,12 @@
             $rev = $arg;
           }
+        elsif (! defined $author && $mode eq 'revprop-change')
+          {
+            $author = $arg;
+          }
+        elsif (! defined $propname && $mode eq 'revprop-change')
+          {
+            $propname = $arg;
+          }
         else
           {
@@ -160,7 +247,12 @@
   }
 
-# If the revision number is undefined, then there were not enough
-# command line arguments.
-&usage("$0: too few arguments.") unless defined $rev;
+if ($mode eq 'commit')
+  {
+    &usage("$0: too few arguments.") unless defined $rev;
+  }
+elsif ($mode eq 'revprop-change')
+  {
+    &usage("$0: too few arguments.") unless defined $propname;
+  }
 
 # Check the validity of the command line arguments.  Check that the
@@ -207,22 +299,8 @@
 }
 
-######################################################################
-# Harvest data using svnlook.
-
-# Change into /tmp so that svnlook diff can create its .svnlook
-# directory.
-my $tmp_dir = '/tmp';
-chdir($tmp_dir)
-  or die "$0: cannot chdir `$tmp_dir': $!\n";
-
-# Get the author, date, and log from svnlook.
-my @svnlooklines = &read_from_process($svnlook, 'info', $repos, '-r', $rev);
-my $author = shift @svnlooklines;
-my $date = shift @svnlooklines;
-shift @svnlooklines;
-my @log = map { "$_\n" } @svnlooklines;
+# Harvest common data needed for both commit or revprop-change.
 
 # Figure out what directories have changed using svnlook.
-my @dirschanged = &read_from_process($svnlook, 'dirs-changed', $repos, 
+my @dirschanged = &read_from_process($svnlook, 'dirs-changed', $repos,
                                      '-r', $rev);
 
@@ -243,5 +321,5 @@
 
 # Figure out what files have changed using svnlook.
-@svnlooklines = &read_from_process($svnlook, 'changed', $repos, '-r', $rev);
+my @svnlooklines = &read_from_process($svnlook, 'changed', $repos, '-r', $rev);
 
 # Parse the changed nodes.
@@ -276,89 +354,155 @@
   }
 
-# Get the diff from svnlook.
-my @no_diff_deleted = $no_diff_deleted ? ('--no-diff-deleted') : ();
-my @difflines = &read_from_process($svnlook, 'diff', $repos,
-                                   '-r', $rev, @no_diff_deleted);
-
-######################################################################
-# Modified directory name collapsing.
-
-# Collapse the list of changed directories only if the root directory
-# was not modified, because otherwise everything is under root and
-# there's no point in collapsing the directories, and only if more
-# than one directory was modified.
-my $commondir = '';
-if (!$rootchanged and @dirschanged > 1)
-  {
-    my $firstline    = shift @dirschanged;
-    my @commonpieces = split('/', $firstline);
-    foreach my $line (@dirschanged)
-      {
-        my @pieces = split('/', $line);
-        my $i = 0;
-        while ($i < @pieces and $i < @commonpieces)
-          {
-            if ($pieces[$i] ne $commonpieces[$i])
-              {
-                splice(@commonpieces, $i, @commonpieces - $i);
-                last;
-              }
-            $i++;
-          }
-      }
-    unshift(@dirschanged, $firstline);
-
-    if (@commonpieces)
-      {
-        $commondir = join('/', @commonpieces);
-        my @new_dirschanged;
-        foreach my $dir (@dirschanged)
-          {
-            if ($dir eq $commondir)
-              {
-                $dir = '.';
-              }
-            else
-              {
-                $dir =~ s#^$commondir/##;
-              }
-            push(@new_dirschanged, $dir);
-          }
-        @dirschanged = @new_dirschanged;
-      }
-  }
-my $dirlist = join(' ', @dirschanged);
-
-######################################################################
-# Assembly of log message.
-
-# Put together the body of the log message.
+# Declare variables which carry information out of the inner scope of
+# the conditional blocks below.
+my $subject_base;
+my $subject_logbase;
 my @body;
-push(@body, "Author: $author\n");
-push(@body, "Date: $date\n");
-push(@body, "New Revision: $rev\n");
-push(@body, "\n");
-if (@adds)
-  {
-    @adds = sort @adds;
-    push(@body, "Added:\n");
-    push(@body, map { "   $_\n" } @adds);
-  }
-if (@dels)
-  {
-    @dels = sort @dels;
-    push(@body, "Removed:\n");
-    push(@body, map { "   $_\n" } @dels);
-  }
-if (@mods)
-  {
-    @mods = sort @mods;
-    push(@body, "Modified:\n");
-    push(@body, map { "   $_\n" } @mods);
-  }
-push(@body, "Log:\n");
-push(@body, @log);
-push(@body, "\n");
-push(@body, map { /[\r\n]+$/ ? $_ : "$_\n" } @difflines);
+# $author - declared above for use as a command line parameter in
+#   revprop-change mode.  In commit mode, gets filled in below.
+
+if ($mode eq 'commit')
+  {
+    ######################################################################
+    # Harvest data using svnlook.
+
+    # Get the author, date, and log from svnlook.
+    my @infolines = &read_from_process($svnlook, 'info', $repos, '-r', $rev);
+    $author = shift @infolines;
+    $date = shift @infolines;
+    shift @infolines;
+    my @log = map { "$_\n" } @infolines;
+
+    ######################################################################
+    # Modified directory name collapsing.
+
+    # Collapse the list of changed directories only if the root directory
+    # was not modified, because otherwise everything is under root and
+    # there's no point in collapsing the directories, and only if more
+    # than one directory was modified.
+    my $commondir = '';
+    my @edited_dirschanged = @dirschanged;
+    if (!$rootchanged and @edited_dirschanged > 1)
+      {
+        my $firstline    = shift @edited_dirschanged;
+        my @commonpieces = split('/', $firstline);
+        foreach my $line (@edited_dirschanged)
+          {
+            my @pieces = split('/', $line);
+            my $i = 0;
+            while ($i < @pieces and $i < @commonpieces)
+              {
+                if ($pieces[$i] ne $commonpieces[$i])
+                  {
+                    splice(@commonpieces, $i, @commonpieces - $i);
+                    last;
+                  }
+                $i++;
+              }
+          }
+        unshift(@edited_dirschanged, $firstline);
+
+        if (@commonpieces)
+          {
+            $commondir = join('/', @commonpieces);
+            my @new_dirschanged;
+            foreach my $dir (@edited_dirschanged)
+              {
+                if ($dir eq $commondir)
+                  {
+                    $dir = '.';
+                  }
+                else
+                  {
+                    $dir =~ s#^\Q$commondir/\E##;
+                  }
+                push(@new_dirschanged, $dir);
+              }
+            @edited_dirschanged = @new_dirschanged;
+          }
+      }
+    my $dirlist = join(' ', @edited_dirschanged);
+
+    ######################################################################
+    # Assembly of log message.
+
+    if ($commondir ne '')
+      {
+        $subject_base = "r$rev - in $commondir: $dirlist";
+      }
+    else
+      {
+        $subject_base = "r$rev - $dirlist";
+      }
+    my $summary = @log ? $log[0] : '';
+    chomp($summary);
+    $subject_logbase = "r$rev - $summary";
+
+    # Put together the body of the log message.
+    push(@body, "Author: $author\n");
+    push(@body, "Date: $date\n");
+    push(@body, "New Revision: $rev\n");
+    push(@body, "\n");
+    if (@adds)
+      {
+        @adds = sort @adds;
+        push(@body, "Added:\n");
+        push(@body, map { "   $_\n" } @adds);
+      }
+    if (@dels)
+      {
+        @dels = sort @dels;
+        push(@body, "Removed:\n");
+        push(@body, map { "   $_\n" } @dels);
+      }
+    if (@mods)
+      {
+        @mods = sort @mods;
+        push(@body, "Modified:\n");
+        push(@body, map { "   $_\n" } @mods);
+      }
+    push(@body, "Log:\n");
+    push(@body, @log);
+    push(@body, "\n");
+  }
+elsif ($mode eq 'revprop-change')
+  {
+    ######################################################################
+    # 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
+      {
+        @svnlines = &read_from_process($svnlook, 'propget', '--revprop', '-r',
+                                       $rev, $repos, $propname);
+      }
+
+    ######################################################################
+    # Assembly of log message.
+
+    $subject_base = "propchange - r$rev $propname";
+
+    # Put together the body of the log message.
+    push(@body, "Author: $author\n");
+    push(@body, "Revision: $rev\n");
+    push(@body, "Property Name: $propname\n");
+    push(@body, "\n");
+    unless ($diff_file)
+      {
+        push(@body, "New Property Value:\n");
+      }
+    push(@body, map { /[\r\n]+$/ ? $_ : "$_\n" } @svnlines);
+    push(@body, "\n");
+  }
+
+# Cached information - calculated when first needed.
+my @difflines;
 
 # Go through each project and see if there are any matches for this
@@ -387,14 +531,9 @@
     my $reply_to        = $project->{reply_to};
     my $subject_prefix  = $project->{subject_prefix};
-    my $subject;
-
-    if ($commondir ne '')
-      {
-        $subject = "r$rev - in $commondir: $dirlist";
-      }
-    else
-      {
-        $subject = "r$rev - $dirlist";
-      }
+    my $summary         = $project->{summary};
+    my $diff_wanted     = ($project->{show_diff} and $mode eq 'commit');
+    my $stdout          = $project->{stdout};
+
+    my $subject         = $summary ? $subject_logbase : $subject_base;
     if ($subject_prefix =~ /\w/)
       {
@@ -411,6 +550,19 @@
         $mail_from = "$mail_from\@$hostname";
       }
+    elsif (defined $smtp_server and ! $stdout)
+      {
+        die "$0: use of either `-h' or `--from' is mandatory when ",
+            "sending email using direct SMTP.\n";
+      }
 
     my @head;
+    my $formatted_date;
+    if (defined $stdout)
+      {
+        $formatted_date = strftime('%a %b %e %X %Y', localtime());
+        push(@head, "From $mail_from $formatted_date\n");
+      }
+    $formatted_date = strftime('%a, %e %b %Y %X %z', localtime());
+    push(@head, "Date: $formatted_date\n");
     push(@head, "To: $to\n");
     push(@head, "From: $mail_from\n");
@@ -425,20 +577,20 @@
     # To: dev@subversion.tigris.org
     # Date: Fri, 19 Jul 2002 23:42:32 -0700
-    # 
+    #
     # Well... that isn't strictly true. The contents of the files
     # might not be UTF-8, so the "diff" portion will be hosed.
-    # 
+    #
     # If you want a truly "proper" commit message, then you'd use
     # multipart MIME messages, with each file going into its own part,
     # and labeled with an appropriate MIME type and charset. Of
     # course, we haven't defined a charset property yet, but no biggy.
-    # 
+    #
     # Going with multipart will surely throw out the notion of "cut
     # out the patch from the email and apply." But then again: the
     # commit emailer could see that all portions are in the same
-    # charset and skip the multipart thang. 
-    # 
+    # charset and skip the multipart thang.
+    #
     # etc etc
-    # 
+    #
     # Basically: adding/tweaking the content-type is nice, but don't
     # think that is the proper solution.
@@ -448,11 +600,28 @@
     push(@head, "\n");
 
-    if ($sendmail =~ /\w/ and @email_addresses)
+    if ($diff_wanted and not @difflines)
+      {
+        # Get the diff from svnlook.
+        my @no_diff_deleted = $no_diff_deleted ? ('--no-diff-deleted') : ();
+        my @no_diff_added = $no_diff_added ? ('--no-diff-added') : ();
+        @difflines = &read_from_process($svnlook, 'diff', $repos,
+                                        '-r', $rev, @no_diff_deleted,
+                                        @no_diff_added);
+        @difflines = map { /[\r\n]+$/ ? $_ : "$_\n" } @difflines;
+      }
+
+    if ($stdout)
+      {
+        print @head, @body;
+        print @difflines if $diff_wanted;
+      }
+    elsif (defined $sendmail and @email_addresses)
       {
         # Open a pipe to sendmail.
-        my $command = "$sendmail $userlist";
+        my $command = "$sendmail -f'$mail_from' $userlist";
         if (open(SENDMAIL, "| $command"))
           {
             print SENDMAIL @head, @body;
+            print SENDMAIL @difflines if $diff_wanted;
             close SENDMAIL
               or warn "$0: error in closing `$command' for writing: $!\n";
@@ -463,4 +632,19 @@
           }
       }
+    elsif (defined $smtp_server and @email_addresses)
+      {
+        my $smtp = Net::SMTP->new($smtp_server)
+          or die "$0: error opening SMTP session to `$smtp_server': $!\n";
+        handle_smtp_error($smtp, $smtp->mail($mail_from));
+        handle_smtp_error($smtp, $smtp->recipient(@email_addresses));
+        handle_smtp_error($smtp, $smtp->data());
+        handle_smtp_error($smtp, $smtp->datasend(@head, @body));
+        if ($diff_wanted)
+          {
+            handle_smtp_error($smtp, $smtp->datasend(@difflines));
+          }
+        handle_smtp_error($smtp, $smtp->dataend());
+        handle_smtp_error($smtp, $smtp->quit());
+      }
 
     # Dump the output to logfile (if its name is not empty).
@@ -470,4 +654,5 @@
           {
             print LOGFILE @head, @body;
+            print LOGFILE @difflines if $diff_wanted;
             close LOGFILE
               or warn "$0: error in closing `$log_file' for appending: $!\n";
@@ -481,35 +666,58 @@
 
 exit 0;
+
+sub handle_smtp_error
+{
+  my ($smtp, $retval) = @_;
+  if (not $retval)
+    {
+      die "$0: SMTP Error: " . $smtp->message() . "\n";
+    }
+}
 
 sub usage
 {
   warn "@_\n" if @_;
-  die "usage: $0 REPOS REVNUM [[-m regex] [options] [email_addr ...]] ...\n",
-      "options are\n",
+  die "usage (commit mode):\n",
+      "  $0 REPOS REVNUM [[-m regex] [options] [email_addr ...]] ...\n",
+      "usage: (revprop-change mode):\n",
+      "  $0 --revprop-change REPOS REVNUM USER PROPNAME [-d diff_file] \\\n",
+      "    [[-m regex] [options] [email_addr ...]] ...\n",
+      "options are:\n",
+      "  -m regex              Regular expression to match committed path\n",
       "  --from email_address  Email address for 'From:' (overrides -h)\n",
       "  -h hostname           Hostname to append to author for 'From:'\n",
       "  -l logfile            Append mail contents to this log file\n",
-      "  -m regex              Regular expression to match committed path\n",
       "  -r email_address      Email address for 'Reply-To:'\n",
       "  -s subject_prefix     Subject line prefix\n",
+      "  --summary             Use first line of commit log in subject\n",
+      "  --diff y|n            Include diff in message (default: y)\n",
+      "                        (applies to commit mode only)\n",
+      "  --stdout              Spit the message in mbox format to stdout.\n",
       "\n",
       "This script supports a single repository with multiple projects,\n",
-      "where each project receives email only for commits that modify that\n",
-      "project.  A project is identified by using the -m command line\n",
-      "with a regular expression argument.  If a commit has a path that\n",
-      "matches the regular expression, then the entire commit matches.\n",
-      "Any of the following -h, -l, -r and -s command line options and\n",
-      "following email addresses are associated with this project.  The\n",
-      "next -m resets the -h, -l, -r and -s command line options and the\n",
-      "list of email addresses.\n",
+      "where each project receives email only for actions that affect that\n",
+      "project.  A project is identified by using the -m command line\n".
+      "option with a regular expression argument.  If the given revision\n",
+      "contains modifications to a path that matches the regular\n",
+      "expression, then the action applies to the project.\n",
+      "\n",
+      "Any of the following email addresses and command line options\n",
+      "(other than -d) are associated with this project, until the next -m,\n",
+      "which resets the options and the list of email addresses.\n",
       "\n",
       "To support a single project conveniently, the script initializes\n",
       "itself with an implicit -m . rule that matches any modifications\n",
-      "to the repository.  Therefore, to use the script for a single\n",
-      "project repository, just use the other comand line options and\n",
+      "to the repository.  Therefore, to use the script for a single-\n",
+      "project repository, just use the other command line options and\n",
       "a list of email addresses on the command line.  If you do not want\n",
-      "a project that matches the entire repository, then use a -m with a\n",
+      "a rule that matches the entire repository, then use -m with a\n",
       "regular expression before any other command line options or email\n",
-      "addresses.\n";
+      "addresses.\n",
+      "\n",
+      "'revprop-change' mode:\n",
+      "The message will contain a copy of the diff_file if it is provided,\n",
+      "otherwise a copy of the (assumed to be new) property value.\n",
+      "\n";
 }
 
@@ -524,5 +732,15 @@
           match_regex     => '.',
           reply_to        => '',
-          subject_prefix  => ''};
+          subject_prefix  => '',
+          show_diff       => 1,
+          stdout          => 0};
+}
+
+sub parse_boolean
+{
+  if ($_[0] eq 'y') { return 1; };
+  if ($_[0] eq 'n') { return 0; };
+
+  die "$0: valid boolean options are 'y' or 'n', not '$_[0]'\n";
 }
 
@@ -535,15 +753,35 @@
     }
 
-  my $pid = open(SAFE_READ, '-|');
-  unless (defined $pid)
-    {
-      die "$0: cannot fork: $!\n";
-    }
-  unless ($pid)
-    {
-      open(STDERR, ">&STDOUT")
-        or die "$0: cannot dup STDOUT: $!\n";
-      exec(@_)
-        or die "$0: cannot exec `@_': $!\n";
+  my $openfork_available = $^O ne "MSWin32"; 
+  if ($openfork_available) # We can fork on this system.
+    {
+      my $pid = open(SAFE_READ, '-|');
+      unless (defined $pid)
+        {
+          die "$0: cannot fork: $!\n";
+        }
+      unless ($pid)
+        {
+          open(STDERR, ">&STDOUT")
+            or die "$0: cannot dup STDOUT: $!\n";
+          exec(@_)
+            or die "$0: cannot exec `@_': $!\n";
+        }
+    }
+  else  # Running on Windows.  No fork. 
+    {
+      my @commandline = ();
+      my $arg;
+      
+      while ($arg = shift)
+        {
+          $arg =~ s/\"/\\\"/g;
+          if ($arg eq "" or $arg =~ /\s/) { $arg = "\"$arg\""; }
+          push(@commandline, $arg);
+        }
+        
+      # Now do the pipe.
+      open(SAFE_READ, "@commandline |")
+        or die "$0: cannot pipe to command: $!\n";
     }
   my @output;