Enlightenment CVS committal

Author  : xcomputerman
Module  : CVSROOT

Dir     : CVSROOT


Modified Files:
        ciabot.pl loginfo 


Log Message:
CIA Bot gets an upgrade (new XML format)


===================================================================
RCS file: /cvsroot/enlightenment/CVSROOT/ciabot.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -3 -r1.4 -r1.5
--- ciabot.pl   3 Nov 2003 01:30:20 -0000       1.4
+++ ciabot.pl   14 Jan 2004 17:34:40 -0000      1.5
@@ -5,31 +5,33 @@
 # Loosely based on cvslog by Russ Allbery <[EMAIL PROTECTED]>
 # Copyright 1998  Board of Trustees, Leland Stanford Jr. University
 #
-# Copyright 2001, 2003  Petr Baudis <[EMAIL PROTECTED]>
+# Copyright 2001, 2003, 2004  Petr Baudis <[EMAIL PROTECTED]>
 #
 # This program is free software; you can redistribute it and/or modify it under
 # the terms of the GNU General Public License version 2, as published by the
 # Free Software Foundation.
 #
 # The master location of this file is
-# http://pasky.ji.cz/~pasky/dev/cvs/ciabot.pl.
+# http://pasky.or.cz/~pasky/dev/cvs/ciabot.pl.
 #
 # This program is designed to run from the loginfo CVS administration file. It
 # takes a log message, massaging it and mailing it to the address given below.
 #
 # Its record in the loginfo file should look like:
 #
-#       ALL        $CVSROOT/CVSROOT/ciabot.pl %s $USER project from_email dest_email
+#       ALL        $CVSROOT/CVSROOT/ciabot.pl %s $USER project from_email dest_email 
ignore_regexp
 #
-# Note that the last three parameters are optional, you can alternatively change
+# Note that the last four parameters are optional, you can alternatively change
 # the defaults below in the configuration section.
 #
-# $Id: ciabot.pl,v 1.4 2003/11/03 01:30:20 raster Exp $
+# If it does not work, try to disable $xml_rpc in the configuration section
+# below.
+#
+# $Id: ciabot.pl,v 1.5 2004/01/14 17:34:40 xcomputerman Exp $
 
 use strict;
-use vars qw ($project $from_email $dest_email @sendmail $max_lines $max_files
-               $sync_delay $xml $commit_template $branch_template
-               $trimmed_template);
+use vars qw ($project $from_email $dest_email $rpc_uri $sendmail $sync_delay
+               $xml_rpc $ignore_regexp $alt_local_message_target);
 
 
 
@@ -39,23 +41,18 @@
 # Project name (as known to CIA).
 $project = 'e';
 
-# The from address in the generated mails.
+# The from address in generated mails.
 $from_email = '[EMAIL PROTECTED]';
 
 # Mail all reports to this address.
-$dest_email = '[EMAIL PROTECTED]';
+$dest_email = '[EMAIL PROTECTED]';
+
+# If using XML-RPC, connect to this URI.
+$rpc_uri = 'http://cia.navi.cx/RPC2';
 
-# Path to your sendmail binary. If you have it at a different place (and
-# outside of $PATH), add your location at the start of the list. By all means
-# keep the trailing empty string in the array.
[EMAIL PROTECTED] = ('/usr/sbin/sendmail', 'sendmail', '/usr/lib/sendmail', 
'/usr/sbin/sendmail', '');
-
-# The maximal number of lines the log message should have.
-$max_lines = 6;
-
-# Number of files to show at once before an abbreviation (m files in n dirs) is
-# used.
-$max_files = 2;
+# Path to your USCD sendmail compatible binary (your mailer daemon created this
+# program somewhere).
+$sendmail = '/usr/sbin/sendmail';
 
 # Number of seconds to wait for possible concurrent instances. CVS calls up
 # this script for each involved directory separately and this is the sync
@@ -64,44 +61,44 @@
 # directories.
 $sync_delay = 5;
 
-# Shall we use XML format for the commit messages. Note that this is
-# unsupported by the server for now, thus you do not want to do it.
-$xml = 0;
-
-# The template string describing how the commit message should look like.
-# Expansions:
-#  %user%   - who committed it
-#  %tag%    - expands to the branch tag template ($branch_template), if the
-#             commit hapenned in a branch
-#  %module% - the module where the commit happenned
-#  %path%   - the longest common path of all the committed files
-#  %file%   - the file name or number of files (and possibly number of dirs)
-#  %trimmed%- a notice about the log message being trimmed, if it is
-#             ($trimmed_template)
-#  %logmsg% - the log message
-$commit_template = '{green}%user%{normal}%tag% * {light blue}%module%{normal}/%path% 
(%file%): %trimmed%%logmsg%';
-
-# The template string describing how the branch tag name should look like.
-# Expansions:
-#  %tag%    - the tag name
-$branch_template = ' {yellow}%tag%{normal}';
-
-# The template string describing how the trimming notice should look like.
-# Expansions:
-#  none
-$trimmed_template = '(log message trimmed)';
+# This script can communicate with CIA either by mail or by an XML-RPC
+# interface. The XML-RPC interface is faster and more efficient, however you
+# need to have RPC::XML perl module installed, and some large CVS hosting sites
+# (like Savannah or Sourceforge) might not allow outgoing HTTP connections
+# while they allow outgoing mail. Also, this script will hang and eventually
+# not deliver the event at all if CIA server happens to be down, which is
+# unfortunately not an uncommon condition.
+$xml_rpc = 0;
+
+# You can make this bot to totally ignore events concerning the objects
+# specified below. Each object is composed of <module>/<path>/<filename>,
+# therefore file Manifest in root directory of module gentoo will be called
+# "gentoo/Manifest", while file src/bfu/inphist.c of module elinks will be
+# called "elinks/src/bfu/inphist.c". Easy, isn't it?
+#
+# This variable should contain regexp, against which will each object be
+# checked, and if the regexp is matched, the file is ignored. Therefore ie.  to
+# ignore all changes in the two files above and everything concerning module
+# 'admin', use:
+#
+# $ignore_regexp = "^(gentoo/Manifest|elinks/src/bfu/inphist.c|admin/)";
+$ignore_regexp = "";
+
+# It can be useful to also grab the generated XML message by some other
+# programs and ie. autogenerate some content based on it. Here you can specify
+# a file to which it will be appended.
+$alt_local_message_target = "";
 
 
 
 
 ### The code itself
 
-use vars qw ($user $module $tag @files $logmsg);
+use vars qw ($user $module $tag @files $logmsg $message);
 
 my @dir; # This array stores all the affected directories
 my @dirfiles;  # This array is mapped to the @dir array and contains files
                # affected in each directory
-my $logmsg_lines;
 
 
 
@@ -131,6 +128,7 @@
 $project = $ARGV[2] if $ARGV[2];
 $from_email = $ARGV[3] if $ARGV[3];
 $dest_email = $ARGV[4] if $ARGV[4];
+$ignore_regexp = $ARGV[5] if $ARGV[5];
 
 
 # Parse stdin (what's interesting is the tag and log message)
@@ -140,16 +138,28 @@
   last if /^Log Message/;
 }
 
-$logmsg_lines = 0;
 while (<STDIN>) {
   next unless ($_ and $_ ne "\n" and $_ ne "\r\n");
-  $logmsg_lines++;
-  last if ($logmsg_lines > $max_lines);
+  s/&/&amp;/g;
+  s/</&lt;/g;
+  s/>/&gt;/g;
   $logmsg .= $_;
 }
 
 
 
+### Remove to-be-ignored files
+
+$dirfiles[0] = join (' ',
+  grep {
+    my $f = "$module/$dir[0]/$_";
+    $f !~ m/$ignore_regexp/;
+  } split (/\s+/, $dirfiles[0])
+) if ($ignore_regexp);
+exit unless $dirfiles[0];
+
+
+
 ### Sync between the multiple instances potentially being ran simultanously
 
 my $sum; # _VERY_ simple hash of the log message. It is really weak, but I'm
@@ -161,7 +171,7 @@
 $syncfile = "/tmp/cvscia.$project.$module.$sum";
 
 
-if (-f $syncfile) {
+if (-f $syncfile and -w $syncfile) {
   # The synchronization file for this file already exists, so we are not the
   # first ones. So let's just dump what we know and exit.
 
@@ -178,7 +188,9 @@
   # We don't need to care about permissions since all the instances of the one
   # commit will obviously live as the same user.
 
-  system("touch $syncfile");
+  # system("touch") in a different way
+  open(FF, ">>$syncfile") or die "aieee... can't log, can't log! $syncfile blocked!";
+  close(FF);
 
   exit if (fork);
   sleep($sync_delay);
@@ -197,173 +209,118 @@
 
 
 
-### Send out the mail
+### Compose the mail message
 
 
-# Open our mail program
+my ($VERSION) = '2.0';
+my $ts = time;
 
-foreach my $sendmail (@sendmail) {
-  die "$0: cannot fork sendmail: $!\n" unless ($sendmail);
-  open (MAIL, "| $sendmail -t -oi -oem") and last;
+$message = <<EM
+<message>
+   <generator>
+       <name>CIA Perl client for CVS</name>
+       <version>$VERSION</version>
+       <url>http://pasky.or.cz/~pasky/dev/cvs/ciabot.pl</url>
+   </generator>
+   <source>
+       <project>$project</project>
+       <module>$module</module>
+EM
+;
+$message .= "       <branch>$tag</branch>" if ($tag);
+$message .= <<EM
+   </source>
+   <timestamp>
+       $ts
+   </timestamp>
+   <body>
+       <commit>
+           <author>$user</author>
+           <files>
+EM
+;
+
+for (my $dirnum = 0; $dirnum < @dir; $dirnum++) {
+  map {
+    $_ = $dir[$dirnum] . '/' . $_;
+    s#^.*?/##; # weed out the module name
+    s/&/&amp;/g;
+    s/</&lt;/g;
+    s/>/&gt;/g;
+    $message .= "  <file>$_</file>\n";
+  } split(/ /, $dirfiles[$dirnum]);
 }
 
+$message .= <<EM
+           </files>
+           <log>
+$logmsg
+           </log>
+       </commit>
+   </body>
+</message>
+EM
+;
 
-# The mail header
-
-my $subject;
-$subject = "Announce $project";
-my $ctype;
-$ctype = 'text/' . ($xml ? 'xml' : 'plain');
 
-print MAIL <<EOM;
-From: $from_email
-To: $dest_email
-Content-type: $ctype
-Subject: $subject
-
-EOM
 
-
-# Skip all this nonsense if we're doing XML output.
-
-if ($xml) {
-  # TODO: DTD
-  print MAIL "<commit>\n";
-  print MAIL " <author>$user</author>\n";
-  print MAIL " <module>$module</module>\n";
-  print MAIL " <branch>$tag</branch>\n" if ($tag);
-  print MAIL " <objects>\n";
-
-  for (my $dirnum = 0; $dirnum < @dir; $dirnum++) {
-    map {
-      $dir[$dirnum] . '/' . $_;
-      s/ /&nbsp;/g;
-      s/</&lt;/g;
-      s/>/&gt;/g;
-      print "  <file>$_</file>\n";
-    } split(/ /, $dirfiles[$dirnum]);
-  }
-
-  print MAIL " </objects>\n";
-  print MAIL " <message>$logmsg</message>\n";
-  print MAIL "</commit>\n";
-
-  goto body_finished;
+### Write the message to an alt-target
+
+if ($alt_local_message_target and open (ALT, ">>$alt_local_message_target")) {
+  print ALT $message;
+  close ALT;
 }
 
 
-# Compute the longest common path, plus make up the file and directory count
 
-my (@commondir, $files, @showfiles, $dirnum);
+### Send out the XML-RPC message
 
-for ($dirnum = 0; $dirnum < @dir; $dirnum++) {
-  my ($dir) = $dir[$dirnum];
 
-  # Update the @commondir array...
+if ($xml_rpc) {
+  # We gotta be careful from now on. We silence all the warnings because
+  # RPC::XML code is crappy and works with undefs etc.
+  $^W = 0;
+  $RPC::XML::ERROR if (0); # silence perl's compile-time warning
 
-  my (@currdir) = split(/\//, $dir);
-  for (my $cdirnum = 0; $cdirnum < @currdir; $cdirnum++) {
-
-    # Cut the part which is not common(@commondir,@currdir)
-    if (defined $commondir[$cdirnum]
-        and $commondir[$cdirnum] ne $currdir[$cdirnum]) {
-      splice(@commondir, $cdirnum);
-      last;
-    }
-
-    if ($dirnum == 0) {
-      # This is our first run, fill @commondir with @currdir
-      $commondir[$cdirnum] = $currdir[$cdirnum];
-    } elsif (not defined $commondir[$cdirnum]) {
-      # @commondir is over, no need to go on and we can't make it longer,
-      # obviously (it would not be common w/ some of the previous dirs)
-      last;
-    }
-  }
+  require RPC::XML;
+  require RPC::XML::Client;
 
-  # Update the files count
+  my $rpc_client = new RPC::XML::Client $rpc_uri;
+  my $rpc_request = RPC::XML::request->new('hub.deliver', $message);
+  my $rpc_response = $rpc_client->send_request($rpc_request);
 
-  my (@currdirfiles) = split(/ /, $dirfiles[$dirnum]);
-  $files += @currdirfiles;
-
-  # Fill @showfiles
-  for (my $toshowfiles = $max_files;
-       $toshowfiles > 0 and @currdirfiles;
-       $toshowfiles--) {
-    push(@showfiles, [ shift(@currdirfiles), [EMAIL PROTECTED] ]);
+  unless (ref $rpc_response) {
+    die "XML-RPC Error: $RPC::XML::ERROR\n";
   }
+  exit;
 }
 
-die "No files!" unless ($files > 0);
-
-shift(@commondir); # Throw away the module name.
-
-
-# Send out the mail body
-
-
-my ($path) = join('/', @commondir);
 
 
-my ($filestr); # the file name or file count or whatever
-
-if ($files > $max_files) {
-  # Too many files to show their full list
-  $filestr = $files . ' files';
-  if ($dirnum > 1) {
-    $filestr .= ' in ' . $dirnum . ' dirs';
-  }
+### Send out the mail
 
-} else {
-  # Show files list bravely
-  $filestr = '';
-  my @filestr;
-  while ($_ = shift(@showfiles)) {
-    my $filename = $_->[0];
-    my @currdir = @{$_->[1]};
-
-    # commondir will be already displayed (and module too)
-    splice(@currdir, 0, scalar(@commondir) + 1);
-    push(@currdir, '') if (@currdir); # trailing slash
-
-    push(@filestr, join('/', @currdir) . $filename);
-  }
-  $filestr = join(' ', @filestr);
-}
 
+# Open our mail program
 
-my ($trimmedstr); # the trimmed string, if any at all
-if ($logmsg_lines > $max_lines) {
-  $trimmedstr = $trimmed_template;
-} else {
-  $trimmedstr = '';
-}
+open (MAIL, "| $sendmail -t -oi -oem") or die "Cannot execute $sendmail : " . ($?>>8);
 
-my ($tagstr); # the branch name, if any at all
-if ($tag) {
-  $tagstr = $branch_template;
-  $tagstr =~ s/\%tag\%/$tag/g;
-} else {
-  $tagstr = '';
-}
 
-$logmsg = "\n" . $logmsg if ($logmsg_lines > 1);
+# The mail header
 
-my ($bodystr) = $commit_template; # the message to be sent
-$bodystr =~ s/\%user\%/$user/g;
-$bodystr =~ s/\%tag\%/$tagstr/g;
-$bodystr =~ s/\%module\%/$module/g;
-$bodystr =~ s/\%path\%/$path/g;
-$bodystr =~ s/\%file\%/$filestr/g;
-$bodystr =~ s/\%trimmed\%/$trimmedstr/g;
-$bodystr =~ s/\%logmsg\%/$logmsg/g;
+print MAIL <<EOM;
+From: $from_email
+To: $dest_email
+Content-type: text/xml
+Subject: DeliverXML
 
-print MAIL $bodystr."\n";
+EOM
 
+print MAIL $message;
 
-body_finished:
 
 # Close the mail
 
 close MAIL;
-die "$0: sendmail exit status " . $? >> 8 . "\n" unless ($? == 0);
+die "$0: sendmail exit status " . ($? >> 8) . "\n" unless ($? == 0);
+
+# vi: set sw=2:
===================================================================
RCS file: /cvsroot/enlightenment/CVSROOT/loginfo,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -3 -r1.24 -r1.25
--- loginfo     3 Nov 2003 03:48:52 -0000       1.24
+++ loginfo     14 Jan 2004 17:34:40 -0000      1.25
@@ -26,4 +26,4 @@
 #DEFAULT (echo ""; id; echo %{sVv}; date; cat) >> $CVSROOT/CVSROOT/commitlog
 # added myself (testing)
 DEFAULT /usr/bin/perl $CVSROOT/CVSROOT/commit.pl %{sVv}
-ALL /usr/bin/perl $CVSROOT/CVSROOT/ciabot.pl %s $USER e [EMAIL PROTECTED] [EMAIL 
PROTECTED]
+ALL /usr/bin/perl $CVSROOT/CVSROOT/ciabot.pl %s $USER e [EMAIL PROTECTED] [EMAIL 
PROTECTED]




-------------------------------------------------------
This SF.net email is sponsored by: Perforce Software.
Perforce is the Fast Software Configuration Management System offering
advanced branching capabilities and atomic changes on 50+ platforms.
Free Eval! http://www.perforce.com/perforce/loadprog.html
_______________________________________________
enlightenment-cvs mailing list
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/enlightenment-cvs

Reply via email to