2 ################################################################################
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
13 # (c) Copyright 2006, Andrew@DeFaria.com, all rights reserved.
15 ################################################################################
20 use lib "$FindBin::Bin/../lib";
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 (
39 my $from_address = "build\@persistcorp.com";
40 my $to_addresses = "philippe.rollet\@hp.com,andrew.defaria\@hp.com";
45 display "ERROR: $msg\n" if defined $msg;
47 display "Usage: $me\t[-u] [-v] [-d] [-stream <stream>] [-view_tag <view_tag>]
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
60 sub CheckForFailures {
63 my @lines = $log->loglines;
71 if (/Needs Merge "(.*)".*from (.*) base/) {
75 if ($arch eq "windows" or $arch eq "cygwin") {
76 if ($from =~ /.*\\(\w*)\\\d*/) {
80 if ($from =~ /.*\/(\w*)\/\d*/) {
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
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!
100 my ($name, $email, $username);
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) {
109 $username = $line [1];
110 $element .= " \"$name\" ($username)";
113 push @failures, $element;
122 my $view_tag = shift;
125 $log->msg ("Delivering $stream -> $view_tag");
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",
142 $log->msg ("Unable to deliver from $stream -> $view_tag");
145 $log->msg ("Delivery from $stream stream to $view_tag view successful");
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,
160 Usage "Stream must be specified" if !defined $stream;
161 Usage "View tag must be specified" if !defined $view_tag;
163 my $view = new Clearcase::View (tag => $view_tag);
165 Usage "View tag $view_tag is not a valid view" if !defined $view;
167 # Should put in code to validate that the stream is a valid Clearcase object.
169 my $status = Deliver $stream, $view_tag, $log;
170 my $subject = "Delivery from $stream -> $view_tag ";
171 $subject .= $status eq $true ? "succeeded"
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>";
178 my %additional_emails;
180 if ($status ne $true) {
181 my @failures = CheckForFailures ($log);
183 if (scalar @failures gt 0) {
184 $heading .= "\n<p>The following elements could not be automatically merged:</p>";
185 $heading .= "\n<ol>\n";
187 foreach (@failures) {
188 if (/<(.*)>.*\((\w*)\)/) {
189 $additional_emails {$2} = $1;
191 $heading .= "<li>$_</li>\n";
193 $heading .= "</ol>\n";
198 from => $from_address,
200 cc => (join ",", values (%additional_emails)),
202 subject => YMD . ": " . $subject,
204 footing => "-- \n<br>Regards,<br>\n<i>Release Engineering</i>",