tools/update_roundup.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 # A script to update the status of an issue in a Roundup bug tracker
   7 # based on the format of a darcs patch name.
   8 # It is intended to be run from a darcs posthook.
   9
  10 # The format we look for is:
  11 #   resolved issue123
  12 # in the first line of the patch.
  13
  14 use Getopt::Long;
  15
  16 use MIME::Lite;
  17 use XML::Simple;
  18
  19 unless ($ENV{DARCS_PATCHES_XML}) {
  20     die "DARCS_PATCHES_XML was expected to be set in the environment, but was not found.
  21           Are you running this from a Darcs 2.0 or newer posthook?"
  22 }
  23
  24 my $xml = eval { XMLin($ENV{DARCS_PATCHES_XML}); };
  25 die "hmmm.. we couldn't parse your XML. The error was: $@"  if $@;
  26
  27 # $xml structure returned looks like this:
  28 #  'patch' => {
  29 #    'resolved issue123: adding t.t' => {
  30 #        'hash' => '20080215033723-20bb4-54f935f89817985a3e98f3de8e8ac9dad5e8e0e5.gz',
  31 #        'inverted' => 'False',
  32 #        'date' => '20080215033723',
  33 #        'author' => 'Mark Stosberg <mark@summersault.com>',
  34 #        'local_date' => 'Thu Feb 14 22:37:23 EST 2008'
  35 #        },
  36 #     'some other patch' => { ... },
  37
  38 for my $patch_name (keys %{ $xml->{patch} }) {
  39     my $issue_re = qr/resolved? \s+ (issue\d+)/msxi;
  40
  41     next unless ($patch_name =~ $issue_re);
  42     my $issue = $1;
  43     my $patch = $xml->{patch}{$patch_name};
  44
  45     # Using the Command Line would be a simpler alternative.
  46     # my $out = `roundup-admin -i /var/lib/roundup/trackers/darcs set $issue status=resolved-in-unstable`;
  47     # warn "unexpected output: $out" if $out;
  48
  49     my $author = $patch->{author};
  50     # If the Author name contains an @ sign, we take it to be an e-mail address.
  51     # Otherwise, we default to darcs-devel as the sender.
  52     my $email = ($author =~ m/\@/) ? $author : 'darcs-devel@darcs.net';
  53
  54     my $comment = $patch->{comment} ? "\n$patch->{comment}" : '';
  55
  56     my $patch_name_minus_status = $patch_name;
  57     $patch_name_minus_status =~ s/$issue_re(:?\s?)//;
  58
  59      # Each patches can potentially update the status of a different issue, so generates a different e-mail
  60     my $msg = MIME::Lite->new(
  61          From     => $email,
  62          To      =>'bugs@darcs.net',
  63          #To       =>'mark@stosberg.com',
  64          Subject  =>"[$issue] [status=resolved-in-unstable]",
  65          Type     =>'text/plain',
  66          Data     => qq!The following patch updated the status of $issue to be resolved:
  67
  68 * $patch_name $comment
  69
  70 !
  71      );
  72      $msg->send;
  73      # An alternative to actually sending, for debugging.
  74      # use File::Slurp;
  75      # write_file("msg-$patch->{hash}.out",$msg->as_string);
  76 }
  77
  78