rmc/index.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use CGI qw (
   6   :standard
   7   :cgi-lib
   8   start_div end_div
   9   *table
  10   start_Tr end_Tr
  11   start_td end_td
  12   start_pre end_pre
  13   start_thead end_thead
  14 );
  15
  16 =pod
  17
  18 =head1 NAME rmc.pl
  19
  20 Release Mission Control: Customized Release Notes
  21
  22 =head1 VERSION
  23
  24 =over
  25
  26 =item Author
  27
  28 Andrew DeFaria <Andrew@ClearSCM.com>
  29
  30 =item Revision
  31
  32 $Revision: #7 $
  33
  34 =item Created
  35
  36 Thu Mar 20 10:11:53 PDT 2014
  37
  38 =item Modified
  39
  40 $Date: 2015/07/22 $
  41
  42 =back
  43
  44 =head1 SYNOPSIS
  45
  46   $ rmc.pl [-username <username>] [-password <password>]
  47            [-client client] [-port] [-[no]html] [-csv]
  48            [-comments] [-files] [-description]
  49
  50            -from <revRange> [-to <revRange>]
  51            [-branchpath <path>]
  52
  53            [-verbose] [-debug] [-help] [-usage]
  54
  55   Where:
  56
  57     -v|erbose:     Display progress output
  58     -deb|ug:       Display debugging information
  59     -he|lp:        Display full help
  60     -usa|ge:       Display usage
  61     -p|ort:        Perforce server and port (Default: Env P4PORT).
  62     -use|rname:    Name of the user to connect to Perforce with with
  63                    (Default:Env P4USER).
  64     -p|assword:    Password for the user to connect to Perforce with
  65                    (Default: Env P4PASSWD).
  66     -cl|ient:      Perforce Client (Default: Env P4CLIENT)
  67     -co|mments:    Include comments in output
  68     -fi|les:       Include files in output
  69     -cs|v:         Produce a csv file
  70     -des|cription: Include description from Bugzilla
  71     -fr|om:        From revSpec
  72     -l|ong:        Shorthand for -comments & -files
  73     -t|o:          To revSpec (Default: @now)
  74     -b|ranchpath:  Path to limit changes to
  75     -[no]ht|ml:    Whether or not to produce html output
  76
  77 Note that revSpecs are Perforce's way of handling changelist/label/dates. For
  78 more info see p4 help revisions. For your reference:
  79
  80   #rev    - A revision number or one of the following keywords:
  81   #none   - A nonexistent revision (also #0).
  82   #head   - The current head revision (also @now).
  83   #have   - The revision on the current client.
  84   @change - A change number: the revision as of that change.
  85   @client - A client name: the revision on the client.
  86   @label  - A label name: the revision in the label.
  87   @date   - A date or date/time: the revision as of that time.
  88             Either yyyy/mm/dd or yyyy/mm/dd:hh:mm:ss
  89             Note that yyyy/mm/dd means yyyy/mm/dd:00:00:00.
  90             To include all events on a day, specify the next day.
  91
  92 =head1 DESCRIPTION
  93
  94 This script produces release notes on the web or in a .csv file. You can also
  95 produce an .html file by using -html and redirecting stdout.
  96
  97 =cut
  98
  99 use FindBin;
 100 use Getopt::Long;
 101 use Pod::Usage;
 102
 103 use P4;
 104
 105 use lib "$FindBin::Bin/../../Web/common/lib";
 106 use lib "$FindBin::Bin/../../common/lib";
 107 use lib "$FindBin::Bin/../../lib";
 108 use lib "$FindBin::Bin/../lib";
 109
 110 use Display;
 111 use DateUtils;
 112 use JIRAUtils;
 113 use Utils;
 114
 115 #use webutils;
 116
 117 # Globals
 118 my $VERSION  = '$Revision: #7 $';
 119   ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
 120
 121 my $p4;
 122 my @labels;
 123 my $headerPrinted;
 124 my $p4ticketsFile = '/opt/audience/perforce/p4tickets';
 125
 126 my $bugsweb = 'http://bugs.audience.local/show_bug.cgi?id=';
 127 my $p4web   = 'http://p4web.audience.local:8080';
 128 my $jiraWeb = 'http://jira.audience.local/browse/';
 129 my %opts;
 130
 131 my $changesCommand = '';
 132
 133 local $| = 1;
 134
 135 my $title    = 'Release Mission Control';
 136 my $subtitle = 'Select from and to revspecs to see the bugs changes between them';
 137 my $helpStr  = 'Both From and To are Perforce '
 138              . i ('revSpecs')
 139              . '. You can use changelists, labels, dates or clients. For more'
 140              . ' see p4 help revisions or '
 141              . a {
 142                  href   => 'http://www.perforce.com/perforce/r12.2/manuals/cmdref/o.fspecs.html#1047453',
 143                  target => 'rmcHelp',
 144                },
 145                'Perforce File Specifications',
 146              .  '.'
 147              . br
 148              . b ('revSpec examples')
 149              . ': &lt;change&gt;, &lt;client&gt;, &lt;label&gt, '
 150              . '&lt;date&gt; - yyyy/mm/dd or yyyy/mm/dd:hh:mm:ss'
 151              . br
 152              . b ('Note:')
 153              . ' To show all changes after label1 but before label2 use >label1 for From and @label2 for To. Or specify To as now';
 154 my @columnHeadings = (
 155   '#',
 156   'Changelist',
 157   'Bug ID',
 158   'Issue',
 159   'Type',
 160   'Status',
 161   'Fix Versions',
 162   'User ID',
 163   'Date',
 164   '# of Files',
 165   'Summary',
 166   'Checkin Comments',
 167   'Files',
 168 );
 169
 170 sub displayForm (;$$$);
 171
 172 sub footing (;$) {
 173   my ($startTime) = @_;
 174
 175   print '<center>', a {
 176     href => url (-relative => 1). "?csv=1&from=$opts{from}&to=$opts{to}&branchpath=$opts{branchpath}",
 177   }, 'Export CSV</center>' if $opts{from} or $opts{to};
 178
 179   print end_form;
 180
 181   my $script = $FindBin::Script =~ /index.pl/
 182              ? 'rmc.pl'
 183              : $FindBin::Script;
 184
 185   my ($sec, $min, $hour, $mday, $mon, $year) =
 186     localtime ((stat ($script))[9]);
 187
 188   $year += 1900;
 189   $mon++;
 190
 191   my $dateModified   = "$mon/$mday/$year @ $hour:$min";
 192   my $secondsElapsed = $startTime ? time () - $startTime . ' secs' : '';
 193
 194   print end_div;
 195
 196   print start_div {-class => 'copyright'};
 197     print "$script version $VERSION: Last modified: $dateModified";
 198     print " ($secondsElapsed)" if $secondsElapsed;
 199     print br "Copyright &copy; $year, Audience - All rights reserved - Design by ClearSCM";
 200   print end_div;
 201
 202   print end_html;
 203
 204   return;
 205 } # footing
 206
 207 sub errorMsg ($;$) {
 208   my ($msg, $exit) = @_;
 209
 210   unless ($opts{html}) {
 211     error ($msg, $exit);
 212
 213     return
 214   } # if
 215
 216   unless ($headerPrinted) {
 217     print header;
 218     print start_html;
 219
 220     $headerPrinted =1;
 221   } # unless
 222
 223   print font ({class => 'error'}, '<br>ERROR: ') . $msg;
 224
 225   if ($exit) {
 226     footing;
 227     exit $exit;
 228   } # if
 229 } # errorMsg
 230
 231 sub debugMsg ($) {
 232   my ($msg) = @_;
 233
 234   return unless $opts{debug};
 235
 236   unless ($opts{html}) {
 237     debug $msg;
 238
 239     return
 240   } # if
 241
 242   unless ($headerPrinted) {
 243     print header;
 244     print start_html;
 245
 246     $headerPrinted = 1;
 247   } # unless
 248
 249   print font ({class => 'error'}, '<br>DEBUG: ') . $msg;
 250 } # debugMsg
 251
 252 sub formatTimestamp (;$) {
 253   my ($time) = @_;
 254
 255   my $date          = YMDHMS ($time);
 256   my $formattedDate = substr ($date, 0, 4) . '-'
 257                     . substr ($date, 4, 2) . '-'
 258                     . substr ($date, 6, 2) . ' '
 259                     . substr ($date, 9);
 260
 261   return $formattedDate;
 262 } # formatTimestamp
 263
 264 sub p4errors ($) {
 265   my ($cmd) = @_;
 266
 267   my $msg  = "Unable to run \"p4 $cmd\"";
 268      $msg .= $opts{html} ? '<br>' : "\n";
 269
 270   if ($p4->ErrorCount) {
 271     displayForm $opts{from}, $opts{to}, $opts{branchpath};
 272
 273     errorMsg $msg . $p4->Errors, $p4->ErrorCount;
 274   } # if
 275
 276   return;
 277 } # p4errors
 278
 279 sub p4connect () {
 280   $p4 = P4->new;
 281
 282   $p4->SetUser     ($opts{username});
 283   $p4->SetClient   ($opts{client}) if $opts{client};
 284   $p4->SetPort     ($opts{port});
 285
 286   if ($opts{username} eq 'shared') {
 287         $p4->SetTicketFile ($p4ticketsFile);
 288   } else {
 289     $p4->SetPassword ($opts{password});
 290   } # if
 291
 292   verbose_nolf "Connecting to Perforce server $opts{port}...";
 293   $p4->Connect or die "Unable to connect to Perforce Server\n";
 294   verbose 'done';
 295
 296   unless ($opts{username} eq 'shared') {
 297     verbose_nolf "Logging in as $opts{username}\@$opts{port}...";
 298
 299     $p4->RunLogin;
 300
 301     p4errors 'login';
 302
 303     verbose 'done';
 304   } # unless
 305
 306   return $p4;
 307 } # p4connect
 308
 309 sub getChanges ($;$$) {
 310   my ($from, $to, $branchpath) = @_;
 311
 312   $from = "\@$from" unless $from =~ /^@/;
 313   $to   = "\@$to"   unless $to   =~ /^@/;
 314
 315   my $args;
 316      #$args    = '-s shelved ';
 317      $args   .= $branchpath if $branchpath;
 318      $args   .= $from;
 319      $args   .= ",$to" if $to;
 320
 321   my $cmd     = 'changes';
 322   my $changes = $p4->Run ($cmd, $args);
 323
 324   $changesCommand = "p4 $cmd $args" if $opts{debug};
 325
 326   p4errors "$cmd $args";
 327
 328   unless (@$changes) {
 329     if ($to =~ /\@now/i) {
 330       verbose "No changes since $from";
 331     } else {
 332       verbose "No changes between $from - $to";
 333     } # if
 334
 335     return;
 336   } else {
 337     return @$changes;
 338   } # unless
 339 } # getChanges
 340
 341 sub getJobInfo ($) {
 342   my ($job) = @_;
 343
 344   my $jobs = $p4->IterateJobs ("-e $job");
 345
 346   p4errors "jobs -e $job";
 347
 348   $job = $jobs->next if $jobs->hasNext;
 349
 350   return $job;
 351 } # getJobInfo
 352
 353 sub getComments ($) {
 354   my ($changelist) = @_;
 355
 356   my $change = $p4->FetchChange ($changelist);
 357
 358   p4errors "change $changelist";
 359
 360   return $change->{Description};
 361 } # getComments
 362
 363 sub getFiles ($) {
 364   my ($changelist) = @_;
 365
 366   my $files = $p4->Run ('files', "\@=$changelist");
 367
 368   p4errors "files \@=$changelist";
 369
 370   my @files;
 371
 372   push @files, $_->{depotFile} . '#' . $_->{rev} for @$files;
 373
 374   return @files;
 375 } # getFiles
 376
 377 sub displayForm (;$$$) {
 378   my ($from, $to, $branchpath) = @_;
 379
 380   $from //= '<today>';
 381   $to   //= '<today>';
 382
 383   print p {align => 'center', class => 'dim'}, $helpStr;
 384
 385   print start_form {
 386     method  => 'get',
 387     actions => $FindBin::Script,
 388   };
 389
 390   print start_table {
 391     class       => 'table',
 392     align       => 'center',
 393     cellspacing => 1,
 394     width       => '95%',
 395   };
 396
 397   print Tr [th ['From', 'To']];
 398   print start_Tr;
 399   print td {align => 'center'}, textfield (
 400     -name => 'from',
 401     value => $from,
 402     size  => 60,
 403   );
 404   print td {align => 'center'}, textfield (
 405     -name => 'to',
 406     value => $to,
 407     size  => 60,
 408   );
 409   print end_Tr;
 410
 411   print Tr [th {colspan => 2}, 'Branch/Path'];
 412   print start_Tr;
 413   print td {
 414     colspan => 2,
 415     align   => 'center',
 416   }, textfield (
 417     -name => 'branchpath',
 418     value => $branchpath,
 419     size  => 136,
 420   );
 421   print end_Tr;
 422
 423   print start_Tr;
 424   print td {align => 'center', colspan => 2}, b ('Options:'), checkbox (
 425     -name   => 'comments',
 426     id      => 'comments',
 427     onclick => 'toggleOption ("comments");',
 428     label   => 'Comments',
 429     checked => $opts{comments} ? 'checked' : '',
 430     value   => $opts{comments},
 431   ), checkbox (
 432     -name   => 'files',
 433     id      => 'files',
 434     onclick => 'toggleOption ("files");',
 435     label   => 'Files',
 436     checked => $opts{files} ? 'checked' : '',
 437     value   => $opts{files},
 438 #  ), checkbox (
 439 #    -name   => 'group',
 440 #    id      => 'group',
 441 #    onclick => 'groupIndicate();',
 442 #    label   => 'Group Indicate',
 443 #    checked => 'checked',
 444 #    value   => $opts{group},
 445   );
 446
 447   print end_Tr;
 448
 449   print start_Tr;
 450   print td {align => 'center', colspan => 2}, input {
 451     type  => 'Submit',
 452     value => 'Submit',
 453   };
 454   print end_Tr;
 455   print end_table;
 456   print p;
 457
 458   return;
 459 } # displayForm
 460
 461 sub displayChangesHTML (@) {
 462   my (@changes) = @_;
 463
 464   displayForm $opts{from}, $opts{to}, $opts{branchpath};
 465
 466   unless (@changes) {
 467     my $msg  = "No changes found between $opts{from} and $opts{to}";
 468        $msg .= " for $opts{branchpath}";
 469     print p $msg;
 470
 471     return;
 472   } # unless
 473
 474   my $displayComments = $opts{comments} ? '' : 'none';
 475   my $displayFiles    = $opts{files}    ? '' : 'none';
 476
 477   debugMsg "Changes command used: $changesCommand";
 478
 479   print start_table {
 480     class => 'table-autosort',
 481     align => 'center',
 482     width => '95%',
 483   };
 484
 485   print start_thead;
 486   print start_Tr;
 487   print th '#';
 488   print
 489   th {
 490     class => 'table-sortable:numeric table-sortable',
 491     title => 'Click to sort',
 492   }, 'Changelist',
 493   th {
 494     class => 'table-sortable:numeric',
 495     title => 'Click to sort',
 496   }, 'Bug ID',
 497   th {
 498     class => 'table-sortable:numeric',
 499     title => 'Click to sort',
 500   }, 'Issue',
 501   th {
 502     class => 'table-sortable:default table-sortable',
 503     title => 'Click to sort',
 504   }, 'Type',
 505   th {
 506     class => 'table-sortable:default table-sortable',
 507     title => 'Click to sort',
 508   }, 'Status',
 509   th {
 510     class => 'table-sortable:default table-sortable',
 511     title => 'Click to sort',
 512   }, 'Fix Version',
 513   th {
 514     class => 'table-sortable:default table-sortable',
 515     title => 'Click to sort',
 516   }, 'User ID',
 517   th {
 518     class => 'table-sortable:default table-sortable',
 519     title => 'Click to sort',
 520   }, 'Date',
 521   th {
 522     class => 'table-sortable:numeric table-sortable',
 523     title => 'Click to sort',
 524   }, '# of Files',
 525   th 'Summary',
 526   th {
 527     id    => 'comments0',
 528     style => "display: $displayComments",
 529   }, 'Checkin Comments',
 530   th {
 531     id    => 'files0',
 532     style => "display: $displayFiles",
 533   }, 'Files';
 534   print end_Tr;
 535   print end_thead;
 536
 537   my $i = 0;
 538
 539   for (sort {$b->{change} <=> $a->{change}} @changes) {
 540     my %change = %$_;
 541
 542     my @files = getFiles $change{change};
 543
 544     my $job;
 545
 546     for ($p4->Run ('fixes', "-c$change{change}")) { # Why am I uses fixes here?
 547        $job = getJobInfo $_->{Job};
 548        last; # FIXME - doesn't handle muliple jobs.
 549     } # for
 550
 551     $job->{Description} = font {color => '#aaa'}, 'N/A' unless $job;
 552
 553     my ($bugid, $jiraIssue);
 554
 555     if ($job->{Job}) {
 556       if ($job->{Job} =~ /^(\d+)/) {
 557         $bugid = $1;
 558       } elsif ($job->{Job} =~ /^(\w+-\d+)/) {
 559         $jiraIssue = $1;
 560       }
 561     } # if
 562
 563     # Using the following does not guarantee the ordering of the elements
 564     # emitted!
 565     #
 566     # my $buglink  = a {
 567     #   href   => "$bugsweb$bugid",
 568     #   target => 'bugzilla',
 569     # }, $bugid;
 570     #
 571     # IOW sometimes I get <a href="..." target="bugzilla"> and other times I
 572     # get <a target="bugzilla" href="...">! Not cool because the JavaScript
 573     # later on is comparing innerHTML and this messes that up. So we write this
 574     # out by hand instead.
 575     my $buglink     = $bugid
 576                     ? "<a href=\"$bugsweb$bugid\" target=\"bugzilla\">$bugid</a>"
 577                     : font {color => '#aaa'}, 'N/A';
 578     my $jiralink    = $jiraIssue
 579                     ? "<a href=\"$jiraWeb$jiraIssue\" target=\"jira\">$jiraIssue</a>"
 580                     : font {color => '#aaa'}, 'N/A';
 581     my $cllink      = "<a href=\"$p4web/$_->{change}?ac=133\" target=\"p4web\">$_->{change}</a>";
 582     my $userid      = $_->{user};
 583     my $description = $job->{Description};
 584     my $jiraStatus  = font {color => '#aaa'}, 'N/A';
 585     my $issueType   = font {color => '#aaa'}, 'N/A';
 586     my $fixVersions = font {color => '#aaa'}, 'N/A';
 587
 588     if ($jiraIssue) {
 589       my $issue;
 590
 591       eval {$issue = getIssue ($jiraIssue, qw (status issuetype fixVersions))};
 592
 593       unless ($@) {
 594         $jiraStatus = $issue->{fields}{status}{name};
 595         $issueType  = $issue->{fields}{issuetype}{name};
 596
 597         my @fixVersions;
 598
 599         push @fixVersions, $_->{name} for @{$issue->{fields}{fixVersions}};
 600
 601         $fixVersions = join '<br>', @fixVersions;
 602       } # unless
 603     } # if
 604
 605     print start_Tr {id => ++$i};
 606
 607     # Attempting to "right size" the columns...
 608     print
 609       td {width => '10px',  align => 'center'},                       $i,
 610       td {width => '15px',  align => 'center', id => "changelist$i"}, $cllink,
 611       td {width => '60px',  align => 'center', id => "bugzilla$i"},   $buglink,
 612       td {width => '80px',  align => 'center', id => "jira$i"},       $jiralink,
 613       td {width => '50px',  align => 'center', id => "type$i"},       $issueType,
 614       td {width => '50px',  align => 'center', id => "jirastatus$i"}, $jiraStatus,
 615       td {width => '50px',  align => 'center', id => "fixVersion$i"}, $fixVersions,
 616       td {width => '30px',  align => 'center', id => "userid$i"},     a {href => "mailto:$userid\@audience.com" }, $userid,
 617       td {width => '130px', align => 'center'},                       formatTimestamp ($_->{time}),
 618       td {width => '10px',  align => 'center'},                       scalar @files;
 619
 620     if ($description =~ /N\/A/) {
 621       print td {id => "description$i", align => 'center'}, $description;
 622     } else {
 623       print td {id => "description$i"}, $description;
 624     } # if
 625
 626     print
 627       td {id     => "comments$i",
 628           valign => 'top',
 629           style  => "display: $displayComments",
 630       }, pre {class => 'code'}, getComments ($_->{change});
 631
 632     print start_td {
 633       id      => "files$i",
 634       valign  => 'top',
 635       style   => "display: $displayFiles"
 636     };
 637
 638     print start_pre {class => 'code'};
 639
 640     for my $file (@files) {
 641       my ($filelink) = ($file =~ /(.*)\#/);
 642       my ($revision) = ($file =~ /\#(\d+)/);
 643
 644       # Note: For a Perforce "Add to Source Control" operation, revision is
 645       # actually "none". Let's fix this.
 646       $revision = 1 unless $revision;
 647
 648       if ($revision == 1) {
 649         print a {
 650           href   => '#',
 651         }, img {
 652           src   => "$p4web/rundiffprevsmallIcon?ac=20",
 653           title => "There's nothing to diff since this is the first revision",
 654         };
 655       } else {
 656         print a {
 657           href   => "$p4web$filelink?ac=19&rev1=$revision&rev2=" . ($revision - 1),
 658           target => 'p4web',
 659         }, img {
 660           src    => "$p4web/rundiffprevsmallIcon?ac=20",
 661           title  => "Diff rev #$revision vs. rev #" . ($revision -1),
 662         };
 663       } # if
 664
 665       print a {
 666         href   => "$p4web$filelink?ac=22",
 667         target => 'p4web',
 668       }, "$file<br>";
 669     } # for
 670
 671     print end_pre;
 672     print end_td;
 673
 674     print end_Tr;
 675   } # for
 676
 677   print end_table;
 678
 679   return;
 680 } # displayChangesHTML
 681
 682 sub displayChange (\%;$) {
 683   my ($change, $nbr) = @_;
 684
 685   $nbr //= 1;
 686
 687   # Note: $change must about -c!
 688   my $args  = "-c$change->{change}";
 689   my $cmd   = 'fixes';
 690   my $fix = $p4->Run ($cmd, $args);
 691
 692   p4errors "$cmd $args";
 693
 694   errorMsg "Change $change->{change} is associated with multiple jobs. This case is not handled yet" if @$fix > 1;
 695
 696   $fix = $$fix[0];
 697
 698   # If there was no fix associated with this change we will use the change data.
 699   unless ($fix) {
 700     $fix->{Change} = $change->{change};
 701     $fix->{User}   = $change->{user};
 702     $fix->{Date}   = $change->{time};
 703   } # unless
 704
 705   my $job;
 706   $job = getJobInfo ($fix->{Job}) if $fix->{Job};
 707
 708   unless ($job) {
 709     chomp $change->{desc};
 710
 711     $job = {
 712       Description => $change->{desc},
 713       Job         => 'Unknown',
 714     };
 715   } # unless
 716
 717   my ($bugid)  = ($job->{Job} =~ /^(\d+)/);
 718
 719   chomp $job->{Description};
 720
 721   my $description  = "$change->{change}";
 722      $description .= "/$bugid" if $bugid;
 723      $description .= ": $job->{Description} ($fix->{User} ";
 724      $description .= ymdhms ($fix->{Date}) . ')';
 725
 726   display $nbr++ . ") $description";
 727
 728   if ($opts{comments}) {
 729     print "\n";
 730     print "Comments:\n" . '-'x80 . "\n" . getComments ($fix->{Change}) . "\n";
 731   } # if
 732
 733   if ($opts{description}) {
 734     display '';
 735     display "Description:\n" . '-'x80 . "\n" . $job->{Description};
 736   } # if
 737
 738   if ($opts{files}) {
 739     display "Files:\n" . '-'x80;
 740
 741     for (getFiles $fix->{Change}) {
 742       display "\t$_";
 743     } # for
 744
 745     display '';
 746   } # if
 747
 748   return $nbr;
 749 } # displayChangesHTML
 750
 751 sub displayChanges (@) {
 752   my (@changes) = @_;
 753
 754   unless (@changes) {
 755     my $msg  = "No changes found between $opts{from} and $opts{to}";
 756        $msg .= " for $opts{branchpath}";
 757     print p $msg;
 758
 759     return;
 760   } # unless
 761
 762   my $i;
 763
 764   debugMsg "Changes command used: $changesCommand";
 765
 766   $i = displayChange %$_, $i for @changes;
 767
 768   return;
 769 } # displayChanges
 770
 771 sub heading ($;$) {
 772   my ($title, $subtitle) = @_;
 773
 774   print header unless $headerPrinted;
 775
 776   $headerPrinted = 1;
 777
 778   print start_html {
 779     title   => $title,
 780     head    => Link ({
 781       rel   => 'shortcut icon',
 782       href  => 'http://p4web.audience.local:8080/favicon.ico',
 783       type  => 'image/x-icon',
 784     }),
 785     author  => 'Andrew DeFaria <Andrew@ClearSCM.com>',
 786     script  => [{
 787       language => 'JavaScript',
 788       src      => 'rmc.js',
 789     }, {
 790       language => 'JavaScript',
 791       src      => 'rmctable.js',
 792     }],
 793     style      => ['rmc.css'],
 794     onload     => 'setOptions();',
 795   }, $title;
 796
 797   print h1 {class => 'title'}, "<center><img src=\"Audience.png\"> $title</center>";
 798   print h3 "<center><font color='#838'>$subtitle</font></center>" if $subtitle;
 799
 800   return;
 801 } # heading
 802
 803 sub exportCSV ($@) {
 804   my ($filename, @data) = @_;
 805
 806   print header (
 807     -type       => 'application/octect-stream',
 808     -attachment => $filename,
 809   );
 810
 811   # Print heading line
 812   my $columns;
 813
 814   # Note that we do not include the '#' column so start at 1
 815   for (my $i = 1; $i < @columnHeadings; $i++) {
 816     $columns .= "\"$columnHeadings[$i]\"";
 817
 818     $columns .= ',' unless $i == @columnHeadings;
 819   } # for
 820
 821   print "$columns\n";
 822
 823   for (sort {$b->{change} <=> $a->{change}} @data) {
 824     my %change = %$_;
 825
 826     ## TODO: This code is duplicated (See displayChange). Consider refactoring.
 827     # Note: $change must be right next to the -c!
 828     my (%job, $jiraStatus, $issueType, $fixVersions);
 829
 830     for ($p4->Run ('fixes', "-c$change{change}")) {
 831        %job = %{getJobInfo $_->{Job}};
 832        last; # FIXME - doesn't handle muliple jobs.
 833     } # for
 834
 835     $job{Description} = '' unless %job;
 836
 837     my ($bugid, $jiraIssue);
 838
 839     if ($job{Job}) {
 840       if ($job{Job} =~ /^(\d+)/) {
 841         $bugid = $1;
 842       } elsif ($job{Job} =~ /^(\w+-\d+)/) {
 843         $jiraIssue = $1;
 844       }
 845     } # if
 846
 847     if ($jiraIssue) {
 848       my $issue;
 849
 850       eval {$issue = getIssue ($jiraIssue, qw (status issuetype fixVersions))};
 851
 852       unless ($@) {
 853         $jiraStatus = $issue->{fields}{status}{name};
 854         $issueType  = $issue->{fields}{issuetype}{name};
 855
 856         my @fixVersions;
 857
 858         push @fixVersions, $_->{name} for @{$issue->{fields}{fixVersions}};
 859
 860         $fixVersions = join "\n", @fixVersions;
 861       } # unless
 862     } # if
 863
 864     my $job;
 865
 866     unless ($job) {
 867       chomp $change{desc};
 868
 869       $job = {
 870         Description => $change{desc},
 871         Job         => 'Unknown',
 872       };
 873     } # unless
 874     ## End of refactor code
 875
 876     $job{Description} = join ("\r\n", split "\n", $job{Description});
 877
 878     my @files    = getFiles $change{change};
 879     my $comments = join ("\r\n", split "\n", getComments ($change{change}));
 880
 881     # Fix up double quotes in description and comments
 882     $job{Description} =~ s/"/""/g;
 883     $comments         =~ s/"/""/g;
 884
 885     print "$change{change},";
 886     print $bugid       ? "$bugid,"       : ',';
 887     print $jiraIssue   ? "$jiraIssue,"   : ',';
 888     print $issueType   ? "$issueType,"   : ',';
 889     print $jiraStatus  ? "$jiraStatus,"  : ',';
 890     print $fixVersions ? "$fixVersions," : ',';
 891     print "$change{user},";
 892     print '"' . formatTimestamp ($change{time}) . '",';
 893     print scalar @files . ',';
 894     print "\"$job{Description}\",";
 895     print "\"$comments\",";
 896     print '"' . join ("\n", @files) . "\"";
 897     print "\n";
 898   } # for
 899
 900   return;
 901 } # exportCSV
 902
 903 sub main {
 904   # Standard opts
 905   $opts{usage}    = sub { pod2usage };
 906   $opts{help}     = sub { pod2usage (-verbose => 2)};
 907
 908   # Opts for this script
 909   $opts{username}   //= $ENV{P4USER}         || $ENV{USERNAME}    || $ENV{USER};
 910   $opts{client}     //= $ENV{P4CLIENT};
 911   $opts{port}       //= $ENV{P4PORT}         || 'perforce:1666';
 912   $opts{password}   //= $ENV{P4PASSWD};
 913   $opts{html}       //= $ENV{HTML}           || param ('html')    || 1;
 914   $opts{html}         = (-t) ? 0 : 1;
 915   $opts{debug}      //= $ENV{DEBUG}          || param ('debug')   || sub { set_debug };
 916   $opts{verbose}    //= $ENV{VERBOSE}        || param ('verbose') || sub { set_verbose };
 917   $opts{jiraserver} //= 'jira';
 918   $opts{from}         = param 'from';
 919   $opts{to}           = param 'to';
 920   $opts{branchpath}   = param ('branchpath') || '//AudEngr/Import/VSS/...';
 921   $opts{group}        = param 'group';
 922   $opts{comments}   //= $ENV{COMMENTS}       || param 'comments';
 923   $opts{files}      //= $ENV{FILES}          || param 'files';
 924   $opts{long}       //= $ENV{LONG}           || param 'long';
 925   $opts{csv}        //= $ENV{CSV}            || param 'csv';
 926
 927   GetOptions (
 928     \%opts,
 929     'verbose',
 930     'debug',
 931     'help',
 932     'usage',
 933     'port=s',
 934     'username=s',
 935     'password=s',
 936     'client=s',
 937     'comments',
 938     'files',
 939     'description',
 940     'long',
 941     'from=s',
 942     'to=s',
 943     'branchpath=s',
 944     'html!',
 945     'csv',
 946   ) || pod2usage;
 947
 948   $opts{comments} = $opts{files} = 1 if $opts{long};
 949   $opts{debug}    = get_debug        if ref $opts{debug}   eq 'CODE';
 950   $opts{verbose}  = get_verbose      if ref $opts{verbose} eq 'CODE';
 951
 952   # Are we doing HTML?
 953   if ($opts{html}) {
 954     require CGI::Carp;
 955
 956     CGI::Carp->import ('fatalsToBrowser');
 957
 958     $opts{username} ||= 'shared';
 959   } # if
 960
 961   # Needed if using the shared user
 962   if ($opts{username} eq 'shared') {
 963     unless (-f $p4ticketsFile) {
 964       errorMsg "Using 'shared' user but there is no P4TICKETS file ($p4ticketsFile)", 1;
 965     } # unless
 966   } else {
 967     if ($opts{username} and not $opts{password}) {
 968       $opts{password} = GetPassword "I need the Perforce password for $opts{username}";
 969     } # if
 970   } # if
 971
 972   p4connect;
 973
 974   my $jira = Connect2JIRA (undef, undef, $opts{jiraserver});
 975
 976   unless ($opts{from} or $opts{to}) {
 977     if ($opts{html}) {
 978       heading $title, $subtitle;
 979
 980       displayForm $opts{from}, $opts{to}, $opts{branchpath};
 981
 982       footing;
 983
 984       exit;
 985     } # if
 986   } # unless
 987
 988   my $ymd = YMD;
 989   my $midnight = substr ($ymd, 0, 4) . '/'
 990                . substr ($ymd, 4, 2) . '/'
 991                . substr ($ymd, 6, 2) . ':00:00:00';
 992
 993   $opts{to}   //= 'now';
 994   $opts{from} //= $midnight;
 995
 996   $opts{to}     = 'now'     if ($opts{to}   eq '<today>' or $opts{to}   eq '');
 997   $opts{from}   = $midnight if ($opts{from} eq '<today>' or $opts{from} eq '');
 998
 999   my $msg = 'Changes made ';
1000
1001   if ($opts{to} =~ /^now$/i and $opts{from} eq $midnight) {
1002     $msg .= 'today';
1003   } elsif ($opts{to} =~ /^now$/i) {
1004     $msg .= "since $opts{from}";
1005   } else {
1006     $msg .= "between $opts{from} and $opts{to}";
1007   } # if
1008
1009   if ($opts{csv}) {
1010     my $filename = "$opts{from}_$opts{to}.csv";
1011
1012     $filename =~ s/\//-/g;
1013     $filename =~ s/\@//g;
1014
1015     debug "branchpath = $opts{branchpath}";
1016
1017     exportCSV $filename, getChanges $opts{from}, $opts{to}, $opts{branchpath};
1018
1019     return;
1020   } # if
1021
1022   if ($opts{html}) {
1023     heading 'Release Mission Control', $msg;
1024   } else {
1025     display "$msg\n";
1026   } # if
1027
1028   if ($opts{html}) {
1029     my $startTime = time;
1030     displayChangesHTML getChanges $opts{from}, $opts{to}, $opts{branchpath};
1031
1032     footing $startTime;
1033   } else {
1034     displayChanges getChanges $opts{from}, $opts{to}, $opts{branchpath};
1035   } # if
1036
1037   return;
1038 } # main
1039
1040 main;
1041
1042 exit;
1043