Add triggers to notify InnoDB developers when MySQL developers change files

#! /usr/bin/perl

use strict;

use warnings;

use FindBin;

require "$FindBin::Bin/triggers-lib.pl";

# Don't run unless commit was successful

check_status() || exit 0;

my $cset = latest_cset();

# Read most recent ChangeSet's changed files.  Send merge changes along, since

# they'll need to be incorporated in InnoDB's source tree eventually.

my $changes = innodb_get_changes('cset', $cset, 'yes')

  or exit 0;

innodb_send_changes_email($cset, $changes)

  or exit 1;

exit 0;

#! /usr/bin/perl

use strict;

use warnings;

use FindBin;

require "$FindBin::Bin/triggers-lib.pl";

# Don't run unless push/pull was successful

check_status() or exit 0;

# Don't run if push/pull is in local clones

exit 0 if repository_type() eq 'local';

# For each pushed ChangeSet, check it for InnoDB files and send

# diff of entire ChangeSet to InnoDB developers if such changes

# exist.

my $error = 0;

foreach my $cset (read_bk_csetlist())

{

  my $changes = innodb_get_changes('cset', $cset, 'yes')

    or next;

  innodb_send_changes_email($cset, $changes)

    or $error = 1;

}

exit ($error == 0 ? 0 : 1);

#! /usr/bin/perl

use strict;

use warnings;

use FindBin;

require "$FindBin::Bin/triggers-lib.pl";

die "$0: Script error: \$BK_PENDING is not set in pre-commit trigger\n"

  unless defined $ENV{BK_PENDING};

# Read changed files from $BK_PENDING directly.  Do not bother user about

# merge changes; they don't have any choice, the merge must be done.

my $changes = innodb_get_changes('file', $ENV{BK_PENDING}, undef)

  or exit 0;

innodb_inform_and_query_user($changes)

  or exit 1;  # Abort commit

# OK, continue with commit

exit 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.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;