Re: Format of patterns recognized in commit messages for auto-posting in bugs

#!/usr/bin/perl
# -*-Perl-*-
#
# Perl filter to handle the log messages from the checkin of files in
# a directory.  This script will group the lists of files by log
# message, and mail a single consolidated log message at the end of
# the commit.
#
# This file assumes a pre-commit checking program that leaves the
# names of the first and last commit directories in a temporary file.
#
# Contributed by David Hampton <[email protected]>
#
# hacked greatly by Greg A. Woods <[email protected]>
#
# Then chopped down just to send bugzilla email, for git.
use strict;

use POSIX;
use DBI;
use Mail::Header;
use Mail::Internet;

my $bugzillaproduct;

#
#	Subroutines
#
sub see_if_bugzilla_bug_exists {    
  my ($dbh, $product, $id) = @_;

  # Split $PRODUCT and SQL-ify.
  my $sql_product = '';
  for my $i (split (/\s+/, $product)) {
      if ($sql_product ne '') {
	  $sql_product .= ', ';
      }
      $sql_product .= "'" . $i . "'";
  }

  my $sth2 = $dbh->prepare ("SELECT COUNT(*) from bugs where bug_id = $id and product_id = any (select products.id from products where name in ($sql_product))") or return 0;
  $sth2->execute() or return 0;
  my $count = $sth2->fetchrow_array ();
  return $count > 0;
}

sub mail_bug_notification {
    my $name = shift;
    my $subject = shift;
    my $head = Mail::Header->new;
    $head->add('From', '[email protected]');
    $head->add('Subject', $subject);
    $head->add('To', $name);
    my $mail = Mail::Internet->new(Header => $head, Body => \@_);
    die "email send failed\n" if !$mail->send;
}

#
#	Main Body
#

# Initialize basic variables
#
my $debug = 0;

# Parse command line arguments.

while (my $arg = shift @ARGV) {
    if ($arg eq '-d') {
	$debug = 1;
	print STDERR "Debug turned on...\n";
    } elsif ($arg eq '-G') {
	die "Too many '-G' args\n" if $bugzillaproduct;
	$bugzillaproduct = shift @ARGV;
    }
}

# Used with sprintf to form name of Gnats notification mailing list.
# %s argument comse from -G option.
my $MAIL_FORMAT = '%s-bugzilla@localhost';

# Collect the body of the commit message.
binmode STDIN, ":utf8";
my @text = ();
while (<STDIN>) {
    push (@text, $_);
}

my $log_txt = join ('', @text);
my %done_ids = {};

# fche/jakub 2020-04-01 ... this following matches "Apr" and spams PR1
#while ($log_txt =~ m/[^Aa]?(?:bug|PR|BZ)\s+\#?\s*(?:[a-z+-]+\/)?(?:\/)?(\d+)(.*)$/si) {

while ($log_txt =~ m/\s(?:bug|PR|BZ)\s+\#?\s*(?:[a-z0-9+-]+\/)?(?:\/)?(\d+)(.*)$/si) {
    my $bug_id = $1;
    $log_txt = $2;
    if (!defined $done_ids{$bug_id}) {
	$done_ids{$bug_id} = 1;
	# Send mail to Bugzilla, if required.
	if ($bugzillaproduct ne '') {
	    my $dbh = undef;
	    if ($bugzillaproduct eq 'gcc') {
		$dbh = DBI->connect ("dbi:mysql:bugs", "swbugz", "everythingroses");
	    } else  {# elsif ($bugzillaproduct eq 'glibc')
		$dbh = DBI->connect ("dbi:mysql:sourcesbugs", "swbugz", "everythingroses");
	    }
	    if ($debug) {
		print STDERR "Attempting to see if bug $bug_id exists\n";
	    }
	    if (defined $dbh & see_if_bugzilla_bug_exists ($dbh, $bugzillaproduct, $bug_id)) {
		if ($debug) { print STDERR "It does\n"; }
		if ($bugzillaproduct ne 'gcc') {
		    mail_bug_notification( sprintf ($MAIL_FORMAT, "sourceware"), "[Bug $bug_id]", @text);
		} else { 
		    mail_bug_notification( sprintf ($MAIL_FORMAT, $bugzillaproduct), "[Bug $bug_id]", @text);
		}
	    }
	    $dbh->disconnect if defined $dbh;
	}
    }
}

exit 0;