svn-post-commit-copy-to-wiki.pl

   1 #!/usr/bin/perl -w
   2
   3 # Copyright 2005  Alex Schroeder <alex@emacswiki.org>
   4
   5 # Based on commit-email.pl, which is part of Subversion.
   6 # ====================================================================
   7 # Copyright (c) 2000-2004 CollabNet.  All rights reserved.
   8 #
   9 # This software is licensed as described in the file COPYING, which
  10 # you should have received as part of this distribution.  The terms
  11 # are also available at http://subversion.tigris.org/license-1.html.
  12 # If newer versions of this license are posted there, you may use a
  13 # newer version instead, at your option.
  14 #
  15 # This software consists of voluntary contributions made by many
  16 # individuals.  For exact contribution history, see the revision
  17 # history and logs, available at http://subversion.tigris.org/.
  18 # ====================================================================
  19
  20 # Turn on warnings the best way depending on the Perl version.
  21 BEGIN {
  22   if ( $] >= 5.006_000)
  23     { require warnings; import warnings; }
  24   else
  25     { $^W = 1; }
  26 }
  27
  28 use strict;
  29 use Carp;
  30 use File::Basename;
  31 use LWP::UserAgent;
  32
  33 ######################################################################
  34 # Configuration section.
  35
  36 # Svnlook path.
  37 my $svnlook = "/usr/bin/svnlook";
  38
  39 # End of Configuration section.
  40 ######################################################################
  41
  42 # Since the path to svnlook depends upon the local installation
  43 # preferences, check that the required programs exist to insure that
  44 # the administrator has set up the script properly.
  45 {
  46   my $ok = 1;
  47   foreach my $program ($svnlook)
  48     {
  49       if (-e $program)
  50         {
  51           unless (-x $program)
  52             {
  53               warn "$0: required program `$program' is not executable, ",
  54                    "edit $0.\n";
  55               $ok = 0;
  56             }
  57         }
  58       else
  59         {
  60           warn "$0: required program `$program' does not exist, edit $0.\n";
  61           $ok = 0;
  62         }
  63     }
  64   exit 1 unless $ok;
  65 }
  66
  67
  68 ######################################################################
  69 # Initial setup/command-line handling.
  70
  71 # repository path, revision number, and url to post to
  72 my ($repos, $rev, $url) = @ARGV;
  73
  74 # If the last argument is undefined, then there were not enough
  75 # command line arguments.
  76 &usage("$0: too few arguments.") unless defined $url;
  77
  78 # Check the validity of the command line arguments.  Check that the
  79 # revision is an integer greater than 0 and that the repository
  80 # directory exists.
  81 unless ($rev =~ /^\d+/ and $rev > 0)
  82   {
  83     &usage("$0: revision number `$rev' must be an integer > 0.");
  84   }
  85 unless (-e $repos)
  86   {
  87     &usage("$0: repos directory `$repos' does not exist.");
  88   }
  89 unless (-d _)
  90   {
  91     &usage("$0: repos directory `$repos' is not a directory.");
  92   }
  93 unless ($url =~ m!http://!)
  94   {
  95     &usage("$0: wiki url `$url' is not an URL.");
  96   }
  97
  98 ######################################################################
  99 # Harvest data using svnlook.
 100
 101 # Get the author, date, and log from svnlook.
 102 my @svnlooklines = &read_from_process($svnlook, 'info', $repos, '-r', $rev);
 103 my $author = shift @svnlooklines;
 104 my $date = shift @svnlooklines;
 105 shift @svnlooklines;
 106 my @log = @svnlooklines;
 107
 108 # Figure out what files have changed using svnlook.
 109 @svnlooklines = &read_from_process($svnlook, 'changed', $repos, '-r', $rev);
 110
 111 # Parse the changed nodes.
 112 my @paths = ();
 113 foreach my $line (@svnlooklines)
 114   {
 115     # Split the line up into the modification code and path, ignoring
 116     # property modifications.
 117     if ($line =~ /^(.).  (.*)$/)
 118       {
 119         push(@paths, $2);
 120       }
 121   }
 122
 123 ######################################################################
 124 # Post to the wiki
 125
 126 foreach my $path (@paths) {
 127   my $id = basename($path);
 128   my $log = join("\n", @log);
 129   my @data = &read_from_process($svnlook, 'cat', $repos, $path, '-r', $rev);
 130   my $data = join("\n", @data);
 131   my $ua = LWP::UserAgent->new;
 132   $ua->post($url, { title=>$id,
 133                     username=>$author,
 134                     summary=>$log,
 135                     text=>$data});
 136 }
 137
 138 exit 0;
 139
 140 sub usage
 141 {
 142   warn "@_\n" if @_;
 143   die "usage: $0 REPOS REVNUM URL\n";
 144 }
 145
 146 # Start a child process safely without using /bin/sh.
 147 sub safe_read_from_pipe
 148 {
 149   unless (@_)
 150     {
 151       croak "$0: safe_read_from_pipe passed no arguments.\n";
 152     }
 153
 154   my $pid = open(SAFE_READ, '-|');
 155   unless (defined $pid)
 156     {
 157       die "$0: cannot fork: $!\n";
 158     }
 159   unless ($pid)
 160     {
 161       open(STDERR, ">&STDOUT")
 162         or die "$0: cannot dup STDOUT: $!\n";
 163       exec(@_)
 164         or die "$0: cannot exec `@_': $!\n";
 165     }
 166   my @output;
 167   while (<SAFE_READ>)
 168     {
 169       s/[\r\n]+$//;
 170       push(@output, $_);
 171     }
 172   close(SAFE_READ);
 173   my $result = $?;
 174   my $exit   = $result >> 8;
 175   my $signal = $result & 127;
 176   my $cd     = $result & 128 ? "with core dump" : "";
 177   if ($signal or $cd)
 178     {
 179       warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
 180     }
 181   if (wantarray)
 182     {
 183       return ($result, @output);
 184     }
 185   else
 186     {
 187       return $result;
 188     }
 189 }
 190
 191 # Use safe_read_from_pipe to start a child process safely and return
 192 # the output if it succeeded or an error message followed by the output
 193 # if it failed.
 194 sub read_from_process
 195 {
 196   unless (@_)
 197     {
 198       croak "$0: read_from_process passed no arguments.\n";
 199     }
 200   my ($status, @output) = &safe_read_from_pipe(@_);
 201   if ($status)
 202     {
 203       return ("$0: `@_' failed with this output:", @output);
 204     }
 205   else
 206     {
 207       return @output;
 208     }
 209 }
 210
 211