cc/dominos

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         dominos,v
   5 # Revision:     1.1.1.1
   6 # Description:  Quick script to deliver a stream to an integration view
   7 #               (Hot and fresh in 30 minutes or less! :-)
   8 # Author:       Andrew@DeFaria.com
   9 # Created:      Mon Feb 13 10:35:34 PST 2006
  10 # Modified:     2007/05/17 07:45:48
  11 # Language:     Perl
  12 #
  13 # (c) Copyright 2006, Andrew@DeFaria.com, all rights reserved.
  14 #
  15 ################################################################################
  16 use strict;
  17 use warnings;
  18
  19 use FindBin;
  20 use lib "$FindBin::Bin/../lib";
  21
  22 use Getopt::Long;
  23
  24 use Clearcase;
  25 use Clearcase::View;
  26 use DateUtils;
  27 use Display;
  28 use OSDep;
  29 use Logger;
  30
  31 my $me          = $FindBin::Script;
  32 my $pvob        = $Clearcase::vobtag_prefix . "ilm_pvob";
  33 my $logdir      = $ENV {TMP} ? $ENV {TMP} : ".";
  34 my $log         = Logger->new (
  35   path          => $logdir,
  36   name          => $me,
  37 );
  38
  39 my $from_address = "build\@persistcorp.com";
  40 my $to_addresses = "philippe.rollet\@hp.com,andrew.defaria\@hp.com";
  41
  42 sub Usage {
  43   my $msg = shift;
  44
  45   display "ERROR: $msg\n" if defined $msg;
  46
  47   display "Usage: $me\t[-u] [-v] [-d] [-stream <stream>] [-view_tag <view_tag>]
  48
  49 Where:
  50
  51   -usage:    Display usage
  52   -vebose:   Turn on verbose mode
  53   -debug:    Turn on debug mode
  54   -stream:   Name of stream to deliver from
  55   -view_tag: View tag to deliver to
  56 ";
  57   exit 1;
  58 } # Usage
  59
  60 sub CheckForFailures {
  61   my $log = shift;
  62
  63   my @lines = $log->loglines;
  64
  65   my @failures;
  66   my $element;
  67   my $from;
  68   my $branch;
  69
  70   foreach (@lines) {
  71     if (/Needs Merge "(.*)".*from (.*) base/) {
  72       $element = $1;
  73       $from    = $2;
  74
  75       if ($arch eq "windows" or $arch eq "cygwin") {
  76         if ($from =~ /.*\\(\w*)\\\d*/) {
  77           $branch = $1;
  78         } # if
  79       } else {
  80         if ($from =~ /.*\/(\w*)\/\d*/) {
  81           $branch = $1;
  82         } # if
  83       } # if
  84     } elsif (/merge: Error: \*\*\* Aborting\.\.\./ or
  85              /\*\*\* No Automatic Decision Possible/) {
  86       # Argh! On Windows silly \'s are used and it always interferes
  87       # with things. Even though $element has the requesite doubling
  88       # of the \'s, one gets eaten up by calling system, the
  89       # eventually cleartool call here. So we change them from \ -> /!
  90       $element =~ tr /\\/\// if ($arch eq "windows" or $arch eq "cygwin");
  91       my ($status, @output) = Clearcase::cleartool (
  92         "lshistory -last -directory -branch $branch -fmt \"%Fu %u\" " . $element
  93       );
  94
  95       # Argh, sometimes %Fu above gives only a one name fullname
  96       # (e.g. Bounour). Not only do we need to account for this but we
  97       # have to abandon the hope of composing an email address!
  98       $_ = $output [0];
  99       my @line = split;
 100       my ($name, $email, $username);
 101
 102       if (scalar @line eq 3) {
 103         $name           = $line [0] . " " . $line [1];
 104         $email          = $line [0] . "." . $line [1] . "\@hp.com";
 105         $username       = $line [2];
 106         $element       .= " \"$name\" <$email> ($username)";
 107       } elsif (scalar @line eq 2) {
 108         $name           = $line [0];
 109         $username       = $line [1];
 110         $element       .= " \"$name\" ($username)";
 111       } # if
 112
 113       push @failures, $element;
 114     } # if
 115   } # foreach
 116
 117   return @failures;
 118 } # CheckForFailures
 119
 120 sub Deliver {
 121   my $stream    = shift;
 122   my $view_tag  = shift;
 123   my $log       = shift;
 124
 125   $log->msg ("Delivering $stream -> $view_tag");
 126
 127   # Here we do the actual delivery. Note we use all of -force, -abort
 128   # and -complete. The force option says "Don't prompt me - just do
 129   # it!". The abort says abort this delivery if we cannot do it in an
 130   # automated fashion. The complete options says "If you can
 131   # successfully merge then complete the delivery".
 132   my ($status, @output) = Clearcase::cleartool (
 133     "deliver -force -abort -complete -stream $stream\@\\$pvob -to $view_tag 2>&1",
 134     $true
 135   );
 136
 137   foreach (@output) {
 138     $log->msg ($_);
 139   } # foreach
 140
 141   if ($status ne 0) {
 142     $log->msg ("Unable to deliver from $stream -> $view_tag");
 143     return $false;
 144   } else {
 145     $log->msg ("Delivery from $stream stream to $view_tag view successful");
 146     return $true;
 147   } # if
 148 } # Delivery
 149
 150 # Get options
 151 my $stream;
 152 my $view_tag;
 153 my $result = GetOptions ("debug"                => sub { set_debug },
 154                          "usage"                => sub { Usage },
 155                          "verbose"              => sub { set_verbose },
 156                          "stream=s"             => \$stream,
 157                          "view_tag=s"           => \$view_tag,
 158                         );
 159
 160 Usage "Stream must be specified"        if !defined $stream;
 161 Usage "View tag must be specified"      if !defined $view_tag;
 162
 163 my $view = new Clearcase::View (tag => $view_tag);
 164
 165 Usage "View tag $view_tag is not a valid view" if !defined $view;
 166
 167 # Should put in code to validate that the stream is a valid Clearcase object.
 168
 169 my $status      = Deliver $stream, $view_tag, $log;
 170 my $subject     = "Delivery from $stream -> $view_tag ";
 171 $subject       .= $status eq $true ? "succeeded"
 172                                    : "failed";
 173 my $heading     = "<h3>Delivery from $stream -> $view_tag ";
 174 $heading       .= $status eq $true ? "<font color=green>succeeded</font>"
 175                                    : "<font color=red>failed</font>";
 176 $heading .= "</h3>";
 177
 178 my %additional_emails;
 179
 180 if ($status ne $true) {
 181   my @failures = CheckForFailures ($log);
 182
 183   if (scalar @failures gt 0) {
 184     $heading .= "\n<p>The following elements could not be automatically merged:</p>";
 185     $heading .= "\n<ol>\n";
 186
 187     foreach (@failures) {
 188       if (/<(.*)>.*\((\w*)\)/) {
 189         $additional_emails {$2} = $1;
 190       } # if
 191       $heading .= "<li>$_</li>\n";
 192     } # foreach
 193     $heading .= "</ol>\n";
 194   } # if
 195 } # if
 196
 197 $log->maillog (
 198   from          => $from_address,
 199   to            => $to_addresses,
 200   cc            => (join ",", values (%additional_emails)),
 201   mode          => "html",
 202   subject       => YMD . ": " . $subject,
 203   heading       => $heading,
 204   footing       => "-- \n<br>Regards,<br>\n<i>Release Engineering</i>",
 205 );