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.pl356
1 files changed, 0 insertions, 356 deletions
diff --git a/BitKeeper/triggers/triggers-lib.pl b/BitKeeper/triggers/triggers-lib.pl
deleted file mode 100644
index 65a334ba926..00000000000
--- a/BitKeeper/triggers/triggers-lib.pl
+++ /dev/null
@@ -1,356 +0,0 @@
-# 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.1";
-
-# 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.1. Regex which defines the InnoDB files
-# which should generally not be touched by MySQL developers.
-my $innodb_files_description = <<EOF;
- storage/innobase/*
- mysql-test/t/innodb* (except mysql-test/t/innodb_mysql*)
- mysql-test/r/innodb* (except mysql-test/r/innodb_mysql*)
-EOF
-my $innodb_files_regex = qr{
- ^
- (
- # Case 1: innobase/*
- storage/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)
- )
-}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'$cset');
- print SENDMAIL "$description";
- print SENDMAIL "The complete ChangeSet diffs follow.\n\n";
- print SENDMAIL qx(bk rset -r'$cset' -ah | bk gnupatch -h -dup -T);
-
- close_or_warn(SENDMAIL, "$sendmail -t")
- or return undef;
-
- return 1;
-}
-
-
-1;
View Lorry Controller Status