[Libreoffice-commits] .: scratch/cia
Miklos Vajna
vmiklos at kemper.freedesktop.org
Fri Nov 19 01:58:56 PST 2010
scratch/cia/libreoffice-ciabot.pl | 282 ++++++++++++++++++++++++++++++++++
scratch/cia/run-libreoffice-ciabot.pl | 118 ++++++++++++++
2 files changed, 400 insertions(+)
New commits:
commit 6a1d4bd25effb4c80b2236dea35fdffad1221ee1
Author: Miklos Vajna <vmiklos at frugalware.org>
Date: Fri Nov 19 10:53:56 2010 +0100
Add scripts feeding the CIA bot from Kendy
diff --git a/scratch/cia/libreoffice-ciabot.pl b/scratch/cia/libreoffice-ciabot.pl
new file mode 100644
index 0000000..d0e615a
--- /dev/null
+++ b/scratch/cia/libreoffice-ciabot.pl
@@ -0,0 +1,282 @@
+#!/usr/bin/perl -w
+#
+# ciabot -- Mail a git log message to a given address, for the purposes of CIA
+#
+# Loosely based on cvslog by Russ Allbery <rra at stanford.edu>
+# Copyright 1998 Board of Trustees, Leland Stanford Jr. University
+#
+# Copyright 2001, 2003, 2004, 2005 Petr Baudis <pasky at ucw.cz>
+#
+# 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 in the Cogito repository
+# (see http://www.kernel.org/git/).
+#
+# This program is designed to run as the .git/hooks/post-commit hook. It takes
+# the commit information, massages it and mails it to the address given below.
+#
+# The calling convention of the post-commit hook is:
+#
+# .git/hooks/post-commit $commit_sha1 $branch_name
+#
+# If it does not work, try to disable $xml_rpc in the configuration section
+# below. Also, remember to make the hook file executable.
+#
+#
+# Note that you can (and it might be actually more desirable) also use this
+# script as the GIT update hook:
+#
+# refname=${1#refs/heads/}
+# [ "$refname" = "master" ] && refname=
+# oldhead=$2
+# newhead=$3
+# for merged in $(git rev-list $newhead ^$oldhead | tac); do
+# /path/to/ciabot.pl $merged $refname
+# done
+#
+# This is useful when you use a remote repository that you only push to. The
+# update hook will be triggered each time you push into that repository, and
+# the pushed commits will be reported through CIA.
+
+use strict;
+use vars qw ($project $from_email $dest_email $noisy $rpc_uri $mail
+ $xml_rpc $ignore_regexp $alt_local_message_target);
+
+
+
+
+### Configuration
+
+# Project name (as known to CIA).
+$project = 'LibreOffice';
+
+# The from address in generated mails.
+$from_email = 'kendy at suse.cz';
+
+# Mail all reports to this address.
+#$dest_email = 'cia at cia.navi.cx';
+$dest_email = 'cia at cia.vc';
+
+# If using XML-RPC, connect to this URI.
+$rpc_uri = 'http://cia.navi.cx/RPC2';
+
+# The 'mail' program setup
+$ENV{'MAILRC'} = '/dev/null';
+$ENV{'smtp'} = 'relay.suse.de';
+$mail = 'mail';
+
+# If set, the script will send CIA the full commit message. If unset, only the
+# first line of the commit message will be sent.
+$noisy = 0;
+
+# 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;
+
+# This variable should contain a regexp, against which each file will be
+# checked, and if the regexp is matched, the file is ignored. This can be
+# useful if you do not want auto-updated files, such as e.g. ChangeLog, to
+# appear via CIA.
+#
+# The following example will make the script ignore all changes in two specific
+# files in two different modules, and everything concerning module 'admin':
+#
+# $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 e.g. 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 ($commit $tree @parent $author $committer);
+use vars qw ($user $repo $branch $rev @files $logmsg $message);
+my $line;
+
+
+
+### Input data loading
+
+
+# The commit stuff
+$repo = $ARGV[0];
+$commit = $ARGV[1];
+$branch = $ARGV[2];
+
+open COMMIT, "git cat-file commit $commit|" or die "git cat-file commit $commit: $!";
+my $state = 0;
+$logmsg = '';
+while (defined ($line = <COMMIT>)) {
+ if ($state == 1) {
+ $logmsg .= $line;
+ $noisy or $state++;
+ next;
+ } elsif ($state > 1) {
+ next;
+ }
+
+ chomp $line;
+ unless ($line) {
+ $state = 1;
+ next;
+ }
+
+ my ($key, $value) = split(/ /, $line, 2);
+ if ($key eq 'tree') {
+ $tree = $value;
+ } elsif ($key eq 'parent') {
+ push(@parent, $value);
+ } elsif ($key eq 'author') {
+ $author = $value;
+ } elsif ($key eq 'committer') {
+ $committer = $value;
+ }
+}
+close COMMIT;
+
+
+open DIFF, "git diff-tree -r $parent[0] $tree|" or die "git diff-tree $parent[0] $tree: $!";
+while (defined ($line = <DIFF>)) {
+ chomp $line;
+ my @f;
+ (undef, @f) = split(/\t/, $line, 2);
+ push (@files, @f);
+}
+close DIFF;
+
+
+# Figure out who is doing the update.
+# XXX: Too trivial this way?
+($user) = $author =~ /<(.*?)@/;
+
+
+$rev = substr($commit, 0, 12);
+
+
+
+
+### Remove to-be-ignored files
+
+ at files = grep { $_ !~ m/$ignore_regexp/; } @files
+ if ($ignore_regexp);
+exit unless @files;
+
+
+
+### Compose the mail message
+
+
+my ($VERSION) = '1.0';
+my $ts = time;
+
+$message = <<EM
+<message>
+ <generator>
+ <name>CIA Perl client for Git</name>
+ <version>$VERSION</version>
+ </generator>
+ <source>
+ <project>$project</project>
+ <module>$repo</module>
+EM
+;
+$message .= " <branch>$branch</branch>" if ($branch);
+$message .= <<EM
+ </source>
+ <timestamp>
+ $ts
+ </timestamp>
+ <body>
+ <commit>
+ <author>$user</author>
+ <revision>$rev</revision>
+ <files>
+EM
+;
+
+foreach (@files) {
+ s/&/&/g;
+ s/</</g;
+ s/>/>/g;
+ $message .= " <file>$_</file>\n";
+}
+
+$logmsg =~ s/&/&/g;
+$logmsg =~ s/</</g;
+$logmsg =~ s/>/>/g;
+
+$message .= <<EM
+ </files>
+ <log>
+$logmsg
+ </log>
+ </commit>
+ </body>
+</message>
+EM
+;
+
+
+
+### Write the message to an alt-target
+
+if ($alt_local_message_target and open (ALT, ">>$alt_local_message_target")) {
+ print ALT $message;
+ close ALT;
+}
+
+
+
+### Send out the XML-RPC message
+
+
+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
+
+ require RPC::XML;
+ require RPC::XML::Client;
+
+ 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);
+
+ unless (ref $rpc_response) {
+ die "XML-RPC Error: $RPC::XML::ERROR\n";
+ }
+ exit;
+}
+
+
+
+### Send out the mail
+
+
+# Open our mail program
+
+open (MAIL, "| $mail -r $from_email -s DeliverXML $dest_email") or die "Cannot execute $mail : " . ($?>>8);
+
+
+print MAIL $message;
+
+
+# Close the mail
+
+close MAIL;
+die "$0: mail exit status " . ($? >> 8) . "\n" unless ($? == 0);
+
+# vi: set sw=2:
diff --git a/scratch/cia/run-libreoffice-ciabot.pl b/scratch/cia/run-libreoffice-ciabot.pl
new file mode 100644
index 0000000..bc8c0aa
--- /dev/null
+++ b/scratch/cia/run-libreoffice-ciabot.pl
@@ -0,0 +1,118 @@
+#!/usr/bin/perl -w
+
+if ( ! -d 'bootstrap' ) {
+ print STDERR "Not a directory with libreoffice repos!\n";
+ exit 1;
+}
+
+sub error($) {
+ my ( $message ) = @_;
+ print STDERR "$message\n";
+}
+
+sub get_branches() {
+ my %branches;
+ if ( open REFS, "git show-ref |" ) {
+ while ( <REFS> ) {
+ chomp;
+ if ( /^([^ ]*) refs\/remotes\/origin\/(.*)/ ) {
+ if ( $2 ne 'HEAD' ) {
+ $branches{$2} = $1;
+ }
+ }
+ }
+ close REFS;
+ }
+ else {
+ error( "Cannot call git show-ref." );
+ }
+
+ return \%branches;
+}
+
+sub report($$$) {
+ my ( $repo, $old_ref, $new_ref ) = @_;
+ my %old = %{$old_ref};
+ my %new = %{$new_ref};
+
+ foreach my $key ( keys %new ) {
+ my $branch_name = $key;
+ $branch_name = '' if ( $branch_name eq 'master' );
+
+ my $old_head = $old{$key};
+ my $new_head = $new{$key};
+
+ if ( defined( $old_head ) ) {
+ if ( $old_head ne $new_head ) {
+ if ( open COMMITS, "git rev-list $new_head ^$old_head | tac |" ) {
+ while ( <COMMITS> ) {
+ chomp;
+ print "Sending report about $_ in $key\n";
+ qx(libreoffice-ciabot.pl $repo $_ $branch_name)
+ }
+ close COMMITS;
+ }
+ else {
+ error( "Cannot call git rev-list." );
+ }
+ }
+ }
+ else {
+ # TODO at some stage, we could play with git merge-base, and
+ # report everything etc. but... ;-)
+ print "Sending report about $_ in a newly created branch $key\n";
+ qx(libreoffice-ciabot.pl $repo $new_head $branch_name)
+ }
+ }
+}
+
+print "Checking for changes in the libreoffice repo & sending reports to CIA.vc.\n";
+
+ at all_repos = (
+ "artwork",
+ "base",
+ "bootstrap",
+ "build",
+ "calc",
+ "components",
+ "extensions",
+ "extras",
+ "filters",
+ "help",
+ "impress",
+ "l10n",
+ "libs-core",
+ "libs-extern",
+ "libs-extern-sys",
+ "libs-gui",
+ "postprocess",
+ "sdk",
+ "testing",
+ "ure",
+ "writer"
+);
+
+chomp( my $cwd = `pwd` );
+
+my %old_ref;
+foreach $repo (@all_repos) {
+ chdir "$cwd/$repo";
+ $old_ref{$repo} = get_branches();
+}
+
+while ( 1 ) {
+ foreach $repo (@all_repos) {
+ chdir "$cwd/$repo";
+
+ # update
+ qx(git fetch origin);
+ my $new_ref = get_branches();
+
+ # report
+ report( $repo, $old_ref{$repo}, $new_ref );
+ $old_ref{$repo} = $new_ref;
+ }
+
+ # check every 5 minutes
+ sleep 5*60;
+}
More information about the Libreoffice-commits
mailing list