defaria.com/Computers/code/bin/clearcase/triggers/CheckinPostop.pl

   1 #!/usr/bin/perl -w
   2 ################################################################################
   3 #
   4 # File:         CheckinPostop.pl
   5 # Description:  This script is run on check in post op. It will pick up the
   6 #               bug IDs from the comment and label the elements that have just
   7 #               been checked in.
   8 # Author:       Andrew@DeFaria.com
   9 # Created:      Fri Oct 26 15:32:12  2001
  10 # Language:     Perl
  11 # Modifications:10/22/2002: Changed to not complain about missing bug IDs if
  12 #               the branch was main.
  13 #               04/11/2003: Changed to support multiple bug IDs in the comment.
  14 # (c) Copyright 2003, Andrew@DeFaria.com, all rights reserved
  15 #
  16 ################################################################################
  17 use strict;
  18
  19 BEGIN {
  20   # Add the appropriate path to our modules to @INC array. We use ipconfig to
  21   # get the current host's IP address then determine whether we are in the US
  22   # or China. If neither then we fallback to using T:/Triggers.
  23   my @ipconfig = grep (/IP Address/, `ipconfig`);
  24   my ($ipaddr) = ($ipconfig[0] =~ /(\d{1,3}\.\d{1,3}.\d{1,3}\.\d{1,3})/);
  25
  26   # US is in the subnets of 192 and 172 while China is in the subnet of 10
  27   if ($ipaddr =~ /^192|^172/) {
  28     unshift (@INC, "//sons-clearcase/Views/official/Tools/lib");
  29   } elsif ($ipaddr =~ /^10/) {
  30     unshift (@INC, "//sons-cc/Views/official/Tools/lib");
  31   } else {
  32     die "Internal Error: Unable to find our modules!\n"
  33   } # if
  34 } # BEGIN
  35
  36 use TriggerUtils;
  37
  38 # The following environment variables are set by Clearcase when this
  39 # trigger is called
  40 my $comment = $ENV{CLEARCASE_COMMENT};
  41 my $branch  = $ENV{CLEARCASE_BRTYPE};
  42 my $pname   = $ENV{CLEARCASE_PN};
  43 my $user    = $ENV{CLEARCASE_USER};
  44
  45 sub ExtractBugIDs {
  46   my $comment = shift;
  47
  48   my @fields  = split /\W/,$comment;
  49
  50   # Use associative array to insure uniqueness
  51   my %bugids;
  52   # Return unique array
  53   my @bugids;
  54
  55   foreach (@fields) {
  56     if (/BUGS2[0-9]{8}/) {
  57       $bugids{$_} = $_;
  58     } # if
  59   } # foreach
  60
  61   foreach (keys %bugids) {
  62     push @bugids, $_;
  63   }
  64
  65   return @bugids;
  66 } # ExtractBugIDs
  67
  68 sub mklabel {
  69   my $label = shift;
  70
  71   my $result = system "cleartool lstype lbtype:$label@\\salira > /dev/null 2>&1";
  72
  73   return $result if ($result eq 0);
  74
  75   $result = system "cleartool mklbtype -nc -shared -pbranch $label@\\salira";
  76
  77   if ($result eq 0) {
  78     clearlog "Created label for $label";
  79   } else {
  80     clearlogmsg "Unable to mklbtype for $label (Error #: $result)";
  81   } # if
  82
  83   return $result;
  84 } # mklabel
  85
  86 foreach my $bugid (ExtractBugIDs ($comment)) {
  87   if (mklabel ($bugid) eq 0) {
  88     my $result = system "cleartool mklabel -replace $bugid \"$pname\"";
  89
  90     if ($result ne 0) {
  91       clearlogmsg "Unable to apply label $bugid to $pname (Error #: $result)";
  92       exit 1;
  93     } else {
  94       clearlog "Attached label $bugid to $pname";
  95     } # if
  96
  97     clearlog "Successful postcheckin of $pname on $branch branch with bug ID $bugid";
  98   } # if
  99
 100 } # foreach
 101
 102 exit 0;