summaryrefslogtreecommitdiff
path: root/BitKeeper/triggers/triggers-lib.pl
diff options
context:
space:
mode:
Diffstat (limited to 'BitKeeper/triggers/triggers-lib.pl')
-rw-r--r--BitKeeper/triggers/triggers-lib.pl360
1 files changed, 360 insertions, 0 deletions
diff --git a/BitKeeper/triggers/triggers-lib.pl b/BitKeeper/triggers/triggers-lib.pl
new file mode 100644
index 00000000000..834cd9093d0
--- /dev/null
+++ b/BitKeeper/triggers/triggers-lib.pl
@@ -0,0 +1,360 @@
+# To use this convenience library in a trigger, simply require it at
+# at the top of the script. For example:
+#
+# #! /usr/bin/perl
+#
+# use FindBin;
+# require "$FindBin::Bin/triggers-lib.pl";
+#
+# FindBin is needed, because sometimes a trigger is called from the
+# RESYNC directory, and the trigger dir is ../BitKeeper/triggers
+
+use strict;
+use warnings;
+
+use Carp;
+use FindBin;
+
+
+my $mysql_version = "5.0";
+
+# These addresses must be kept current in all MySQL versions.
+# See the wiki page InnoDBandOracle.
+#my @innodb_to_email = ('dev_innodb_ww@oracle.com');
+#my @innodb_cc_email = ('dev-innodb@mysql.com');
+# FIXME: Keep this for testing; remove it once it's been used for a
+# week or two.
+my @innodb_to_email = ('tim@mysql.com');
+my @innodb_cc_email = ();
+
+# This is for MySQL <= 5.0. Regex which defines the InnoDB files
+# which should generally not be touched by MySQL developers.
+my $innodb_files_description = <<EOF;
+ innobase/*
+ mysql-test/t/innodb* (except mysql-test/t/innodb_mysql*)
+ mysql-test/r/innodb* (except mysql-test/r/innodb_mysql*)
+ sql/ha_innodb*
+EOF
+my $innodb_files_regex = qr{
+ ^
+ (
+ # Case 1: innobase/*
+ innobase/
+ |
+ # Case 2: mysql-test/[tr]/innodb* (except innodb_mysql*)
+ mysql-test/(t|r)/SCCS/s.innodb
+ # The mysql-test/[tr]/innodb_mysql* are OK to edit
+ (?!_mysql)
+ |
+ # Case 3: sql/ha_innodb*
+ sql/SCCS/s.ha_innodb
+ )
+}x;
+
+
+# See 'bk help log', and the format of, e.g., $BK_PENDING.
+# Important: this already contains the terminating newline!
+my $file_rev_dspec = ':SFILE:|:REV:\n';
+
+my $bktmp = "$FindBin::Bin/../tmp";
+
+my $sendmail;
+foreach ('/usr/sbin/sendmail', 'sendmail') {
+ $sendmail = $_;
+ last if -x $sendmail;
+}
+my $from = $ENV{REAL_EMAIL} || $ENV{USER} . '@mysql.com';
+
+
+# close_or_warn
+# $fh file handle to be closed
+# $description description of the file handle
+# RETURN Return value of close($fh)
+#
+# Print a nice warning message if close() isn't successful. See
+# perldoc perlvar and perldoc -f close for details.
+
+sub close_or_warn (*$)
+{
+ my ($fh, $description) = @_;
+
+ my $status = close $fh;
+ if (not $status) {
+ warn "$0: error on close of '$description': ",
+ ($! ? "$!" : "exit status " . ($? >> 8)), "\n";
+ }
+
+ return $status;
+}
+
+
+# check_status
+# $warn If true, warn about bad status
+# RETURN TRUE, if $BK_STATUS is "OK"; FALSE otherwise
+#
+# Also checks the undocumented $BK_COMMIT env variable
+
+sub check_status
+{
+ my ($warn) = @_;
+
+ my $status = (grep { defined $_ }
+ $ENV{BK_STATUS}, $ENV{BK_COMMIT}, '<undef>')[0];
+
+ unless ($status eq 'OK')
+ {
+ warn "Bad BK_STATUS '$status'\n" if $warn;
+ return undef;
+ }
+
+ return 1;
+}
+
+
+# repository_location
+#
+# RETURN ('HOST', 'ROOT') for the repository being modified
+
+sub repository_location
+{
+ if ($ENV{BK_SIDE} eq 'client') {
+ return ($ENV{BK_HOST}, $ENV{BK_ROOT});
+ } else {
+ return ($ENV{BKD_HOST}, $ENV{BKD_ROOT});
+ }
+}
+
+
+# repository_type
+# RETURN:
+# 'main' for repo on bk-internal with post-incoming.bugdb trigger
+# 'team' for repo on bk-internal with post-incoming.queuepush.pl trigger
+# 'local' otherwise
+#
+# This definition may need to be modified if the host name or triggers change.
+
+sub repository_type
+{
+ my ($host, $root) = repository_location();
+
+ return 'local'
+ unless uc($host) eq 'BK-INTERNAL.MYSQL.COM'
+ and -e "$root/BitKeeper/triggers/post-incoming.queuepush.pl";
+
+ return 'main' if -e "$root/BitKeeper/triggers/post-incoming.bugdb";
+
+ return 'team';
+}
+
+
+# latest_cset
+# RETURN Key for most recent ChangeSet
+
+sub latest_cset {
+ chomp(my $retval = `bk changes -r+ -k`);
+ return $retval;
+}
+
+
+# read_bk_csetlist
+# RETURN list of cset keys from $BK_CSETLIST file
+sub read_bk_csetlist
+{
+ die "$0: script error: \$BK_CSETLIST not set\n"
+ unless defined $ENV{BK_CSETLIST};
+
+ open CSETS, '<', $ENV{BK_CSETLIST}
+ or die "$0: can't read \$BK_CSETLIST='$ENV{BK_CSETLIST}': $!\n";
+ chomp(my @csets = <CSETS>);
+ close_or_warn(CSETS, "\$BK_CSETLIST='$ENV{BK_CSETLIST}'");
+
+ return @csets;
+}
+
+
+# innodb_get_changes
+# $type 'file' or 'cset'
+# $value file name (e.g., $BK_PENDING) or ChangeSet key
+# $want_merge_changes flag; if false, merge changes will be ignored
+# RETURN A string describing the InnoDB changes, or undef if no changes
+#
+# The return value does *not* include ChangeSet comments, only per-file
+# comments.
+
+sub innodb_get_changes
+{
+ my ($type, $value, $want_merge_changes) = @_;
+
+ if ($type eq 'file')
+ {
+ open CHANGES, '<', $value
+ or die "$0: can't read '$value': $!\n";
+ }
+ elsif ($type eq 'cset')
+ {
+ open CHANGES, '-|', "bk changes -r'$value' -v -d'$file_rev_dspec'"
+ or die "$0: can't exec 'bk changes': $!\n";
+ }
+ else
+ {
+ croak "$0: script error: invalid type '$type'";
+ }
+
+ my @changes = grep { /$innodb_files_regex/ } <CHANGES>;
+
+ close_or_warn(CHANGES, "($type, '$value')");
+
+ return undef unless @changes;
+
+
+ # Set up a pipeline of 'bk log' commands to weed out unwanted deltas. We
+ # never want deltas which contain no actual changes. We may not want deltas
+ # which are merges.
+
+ my @filters;
+
+ # This tests if :LI: (lines inserted) or :LD: (lines deleted) is
+ # non-zero. That is, did this delta change the file contents?
+ push @filters,
+ "bk log -d'"
+ . "\$if(:LI: -gt 0){$file_rev_dspec}"
+ . "\$if(:LI: -eq 0){\$if(:LD: -gt 0){$file_rev_dspec}}"
+ . "' -";
+
+ push @filters, "bk log -d'\$unless(:MERGE:){$file_rev_dspec}' -"
+ unless $want_merge_changes;
+
+ my $tmpname = "$bktmp/ibchanges.txt";
+ my $pipeline = join(' | ', @filters) . " > $tmpname";
+ open TMP, '|-', $pipeline
+ or die "$0: can't exec [[$pipeline]]: $!\n";
+
+ print TMP @changes;
+ close_or_warn(TMP, "| $pipeline");
+
+ # Use bk log to describe the changes
+ open LOG, "bk log - < $tmpname |"
+ or die "$0: can't exec 'bk log - < $tmpname': $!\n";
+ my @log = <LOG>;
+ close_or_warn(LOG, "bk log - < $tmpname |");
+
+ unlink $tmpname;
+
+ return undef unless @log;
+
+ return join('', @log);
+}
+
+
+# Ask user if they really want to commit.
+# RETURN TRUE = YES, commit; FALSE = NO, do not commit
+
+sub innodb_inform_and_query_user
+{
+ my ($description) = @_;
+
+ my $tmpname = "$bktmp/ibquery.txt";
+
+ open MESSAGE, "> $tmpname"
+ or die "$0: can't write message to '$tmpname': $!";
+
+ print MESSAGE <<EOF;
+This ChangeSet modifies some files which should normally be changed by
+InnoDB developers only. In general, MySQL developers should not change:
+
+$innodb_files_description
+The following InnoDB files were modified:
+=========================================================
+$description
+=========================================================
+
+If you understand this, you may Commit these changes. The changes
+will be sent to the InnoDB developers at @{[join ', ', @innodb_to_email]},
+CC @{[join ', ', @innodb_cc_email]}.
+EOF
+
+ close_or_warn(MESSAGE, "$tmpname");
+
+ my $status = system('bk', 'prompt', '-w',
+ '-yCommit these changes', '-nDo not Commit', "-f$tmpname");
+
+ unlink $tmpname;
+
+ return ($status == 0 ? 1 : undef);
+}
+
+
+# innodb_send_changes_email
+# $cset The ChangeSet key
+# $description A (maybe brief) description of the changes
+# RETURN TRUE = Success, e-mail sent; FALSE = Failure
+#
+# Sends a complete diff of changes in $cset by e-mail.
+
+sub innodb_send_changes_email
+{
+ my ($cset, $description) = @_;
+
+ # FIXME: Much of this is duplicated in the 'post-commit' Bourne shell
+ # trigger
+
+ my $cset_short = `bk changes -r'$cset' -d':P:::I:'`;
+ my $cset_key = `bk changes -r'$cset' -d':KEY:'`;
+
+ my ($host, $bk_root) = repository_location();
+ my $type = repository_type();
+ (my $treename = $bk_root) =~ s,^.*/,,;
+
+ print "Nofifying InnoDB developers at ",
+ (join ', ', @innodb_to_email, @innodb_cc_email), "\n";
+
+ open SENDMAIL, '|-', "$sendmail -t"
+ or die "Can't exec '$sendmail -t': $!\n";
+
+ my @headers;
+ push @headers, "List-ID: <bk.innodb-$mysql_version>";
+ push @headers, "From: $from";
+ push @headers, "To: " . (join ', ', @innodb_to_email);
+ push @headers, "Cc: " . (join ', ', @innodb_cc_email) if @innodb_cc_email;
+ push @headers,
+ "Subject: InnoDB changes in $type $mysql_version tree ($cset_short)";
+ push @headers, "X-CSetKey: <$cset_key>";
+
+ print SENDMAIL map { "$_\n" } @headers, '';
+
+ if ($type eq 'main')
+ {
+ print SENDMAIL <<EOF;
+Changes pushed to $treename by $ENV{USER} affect the following
+files. These changes are in a $mysql_version main tree. They
+will be available publicly within 24 hours.
+EOF
+ }
+ elsif ($type eq 'team')
+ {
+ print SENDMAIL <<EOF;
+Changes added to $treename by $ENV{USER} affect the
+following files. These changes are in a $mysql_version team tree.
+EOF
+ }
+ else
+ {
+ print SENDMAIL <<EOF;
+A local commit by $ENV{USER} affects the following files. These
+changes are in a clone of a $mysql_version tree.
+EOF
+ }
+ print SENDMAIL "\n";
+ print SENDMAIL qx(bk changes -r+);
+ print SENDMAIL "$description";
+ print SENDMAIL "The complete ChangeSet diffs follow.\n\n";
+ print SENDMAIL qx(bk rset -r+ -ah | bk gnupatch -h -dup -T);
+
+ close_or_warn(SENDMAIL, "$sendmail -t")
+ or return undef;
+
+ return 1;
+}
+
+
+1;
View Lorry Controller Status