PageRenderTime 195ms CodeModel.GetById 2ms app.highlight 181ms RepoModel.GetById 1ms app.codeStats 0ms

/CQC/Reports.pm

https://bitbucket.org/cgj/mercury-qc
Perl | 1365 lines | 1198 code | 83 blank | 84 comment | 34 complexity | d52d86770655292165b783df07ab2b35 MD5 | raw file
   1# -*-Perl-*-
   2
   3package CQC::Reports;
   4
   5# use perl to generate Quality Center reports for OSD projects
   6
   7use 5.010_000;
   8use feature qw(say);
   9
  10use strict;
  11use warnings;
  12
  13use vars qw($VERSION);
  14our $VERSION = '0.01.01';
  15
  16# Task 'Export'
  17use Exporter qw(import);
  18our @EXPORT_OK
  19    = qw( rootCauseReport rtmByReqReport rtmByTestReport rtmByTestLabReport rtmReport );
  20our %EXPORT_TAGS = (
  21    ALL => [qw( rootCauseReport rtmByReqReport rtmByTestReport rtmByTestLabReport rtmReport )]);
  22
  23use Data::Dumper;
  24use Log::Log4perl qw(get_logger :nowarn);
  25use Date::Format;
  26use Storable;
  27#use Devel::Size;
  28
  29use Win32::OLE qw(in valof);
  30use Win32::OLE::Variant;
  31use Win32::OLE::Const 'Microsoft Excel';
  32
  33use File::Basename;
  34use File::Spec::Functions qw(:ALL);
  35
  36use Spreadsheet::WriteExcel::Utility;
  37use Net::LDAP;
  38
  39use HTML::TreeBuilder;
  40use HTML::FormatText;
  41
  42use Mercury::OTA qw(connectToQC connectQC disconnectQC releaseConnections
  43    bugView filterText filterGrid);
  44use Mercury::Labels qw(dumpQCLabels assignBugLabels %bugLabel);
  45use CQC::Reporter qw(:ALL);
  46
  47## Initialized Global Variables
  48
  49# -*- subroutines -*-
  50
  51sub rootCauseReport {
  52    my $tdc      = shift;
  53    my $fav      = shift;
  54    my $template = shift;
  55    my $rcReport = shift;
  56
  57    my $color = colorScheme();
  58    my %tab = (
  59        defects         => 'defects',
  60        rcSummary       => 'Root Cause summary',
  61        invalidRC_chart => 'Invalid Root Cause chart',
  62        fullSummary     => 'Full RC summary',
  63        rcSTD           => 'RC by STD',
  64        subTeam         => 'Defects by Sub Team',
  65        scopeID         => 'Defects by Scope ID-CR#',
  66    );
  67
  68    my @pivots
  69        = ($tab{fullSummary}, $tab{rcSTD}, $tab{subTeam}, $tab{scopeID},);
  70    
  71    $template = rel2abs($template);
  72    my $logger = get_logger();
  73    $logger->logdie("$template does not exist.") if (!-e $template);
  74
  75    my $view = bugView($tdc, $fav)
  76        or $logger->logdie("Favorite $fav not found");
  77    my @columns = split ';', filterGrid($view);
  78    my %bugLabel = assignBugLabels($tdc);
  79
  80    my (@fieldLabels, @fieldWidths, %columnIndex, $rcCategory,
  81        $rcPhase,     $rcReason,    $rcUUID,      $rcMgr,
  82        $rcSeverity,  $rcStatus
  83    );
  84    my $columnOffset = 0;
  85    foreach my $column (@columns) {
  86        my ($width, $name) = split ',', $column;
  87        push @fieldLabels, $bugLabel{$name};
  88        push @fieldWidths, $width;
  89        $columnIndex{$bugLabel{$name}} = $columnOffset;
  90        given ($bugLabel{$name}) {
  91            when ('Root Cause Category') {
  92                $rcCategory = $columnOffset;
  93            }
  94            when ('Root Cause Phase') {
  95                $rcPhase = $columnOffset;
  96            }
  97            when ('Root Cause Reason') {
  98                $rcReason = $columnOffset;
  99            }
 100            when ('User 4') {
 101                $rcMgr = $columnOffset;
 102            }
 103            when ('Assigned To UUID') {
 104                $rcUUID = $columnOffset;
 105            }
 106            when ('Severity') {
 107                $rcSeverity = $columnOffset;
 108            }
 109            when ('Status') {
 110                $rcStatus = $columnOffset;
 111            }
 112        }
 113        $columnOffset++;
 114    }
 115    my $rcValid = scalar @columns + 1;
 116
 117    my $defects_ref = getDefects($tdc, $fav);
 118
 119    #    store $defects_ref, 'rcStore';
 120    #    my $defects_ref = retrieve('rcStore');
 121
 122    # set up the report output
 123    $logger->debug("creating spreadsheet...");
 124    my $excel = Win32::OLE->new('Excel.Application', 'Quit')
 125        or $logger->logdie("cannot start Excel: ", Win32::OLE->LastError());
 126
 127    # avoid excessive Excel dialogs
 128    $excel->{DisplayAlerts} = 0;
 129    $excel->{Visible}       = 0;
 130
 131    my $workbook = $excel->Workbooks->Open($template)
 132        or $logger->logdie("Can't open Excel workbook $template: ",
 133        Win32::OLE->LastError());
 134
 135    # Task 'Process Defects'
 136    $logger->debug("processing each defect...");
 137    my %rootCause = getRootCauseMap($workbook);
 138    my (@invalidPhases, @invalidCategories, @invalidReasons, %totalDF, %team,
 139        $manager, $severity, $grandTotal);
 140
 141    foreach my $defect (@{$defects_ref}) {
 142
 143        # assign manager names for each defect
 144        if (not($manager = $defect->[$rcMgr])) {
 145            $manager = $defect->[$rcMgr] = getManager($defect->[$rcUUID]);
 146        }
 147
 148        # cancelled defects are generally not included in the root cause
 149        # analysis, since there's no root cause for something that isn't
 150        # really a defect ;-), so just move on to the continue block
 151        next if ($defect->[$rcStatus] eq 'Cancelled');
 152
 153        # validate the phase
 154        if (not(grep($_ eq $defect->[$rcPhase], @{$rootCause{Phase}}))) {
 155            $defect->[$rcValid] = 'Phase';
 156            push @invalidPhases, $defect;
 157            $team{$manager}{invalid}{total}++;
 158            $team{$manager}{invalid}{rcPhase}++;
 159        }
 160        else {
 161
 162            # validate the category
 163            if (not(grep($_ eq $defect->[$rcCategory],
 164                        @{$rootCause{Categories}})
 165                )
 166                )
 167            {
 168                $defect->[$rcValid] = 'Category';
 169                push @invalidCategories, $defect;
 170                $team{$manager}{invalid}{total}++;
 171                $team{$manager}{invalid}{rcCategory}++;
 172                $totalDF{invalid}{$defect->[$rcCategory]}
 173                    {$defect->[$rcReason]}++;
 174            }
 175            else {
 176
 177                # validate that reasons match categories
 178                if (not(grep ($_ eq $defect->[$rcReason],
 179                            @{  $rootCause{Category}{$defect->[$rcCategory]}
 180                                })
 181                    )
 182                    )
 183                {
 184                    $defect->[$rcValid] = 'Reason';
 185                    push @invalidReasons, $defect;
 186                    $team{$manager}{invalid}{total}++;
 187                    $team{$manager}{invalid}{rcReason}++;
 188                    $totalDF{invalid}{$defect->[$rcCategory]}
 189                        {$defect->[$rcReason]}++;
 190                }
 191                else {
 192
 193                    # if we got all the way to here, the defect must have
 194                    # structurally valid root cause info
 195                    $team{$manager}{valid}++;
 196                    $totalDF{valid}{$defect->[$rcCategory]}
 197                        {$defect->[$rcReason]}++;
 198                }
 199            }
 200        }
 201    }
 202    continue {
 203        $team{$manager}{$defect->[$rcStatus]}++;
 204        $team{$manager}{totalDF}++;
 205        $totalDF{$defect->[$rcStatus]}++;
 206        $grandTotal++;
 207        if ($defect->[$rcStatus] ne 'Cancelled') {
 208            $team{$manager}{$defect->[$rcSeverity]}++;
 209            $totalDF{$defect->[$rcSeverity]}++;
 210        }
 211    }
 212
 213    # Task 'defects'
 214    $logger->debug("starting task defects: populating spreadsheet...");
 215    my $sheet = $workbook->Worksheets($tab{defects})
 216        or $logger->logdie("Can't open Excel worksheet: ",
 217        Win32::OLE->LastError());
 218
 219    #    store $defects_ref, 'rcStore';
 220
 221    # write the defects if we have any
 222    if (scalar @{$defects_ref}) {
 223
 224        # determine the lower-right corner of the range needed
 225        my $corner = xl_rowcol_to_cell(scalar(@{$defects_ref}),
 226            scalar(@{$defects_ref->[0]}) - 1);
 227
 228        $sheet->Range("A2:$corner")->{Value} = $defects_ref;
 229    }
 230
 231    # Task 'Root Cause summary'
 232    $logger->debug("starting task root cause summary...");
 233    $sheet = $workbook->Worksheets($tab{rcSummary})
 234        or $logger->logdie("Can't open Excel worksheet: ",
 235        Win32::OLE->LastError());
 236
 237    # update the sheet date
 238    $sheet->Range('$C$1')->{Value} = xl_parse_date("Today");
 239
 240    my %mgrCharts = (
 241        size    => 105,
 242        gutter  => 3,
 243        valid   => [],
 244        invalid => [],
 245    );
 246
 247    foreach $manager (sort keys %team) {
 248        $team{$manager}{valid} += 0;
 249        foreach my $item qw(total rcPhase rcCategory rcReason) {
 250            $team{$manager}{invalid}{$item} += 0;
 251        }
 252        push @{$mgrCharts{valid}}, $manager if ($team{$manager}{valid});
 253        push @{$mgrCharts{invalid}}, $manager
 254            if ($team{$manager}{invalid}{total});
 255    }
 256    $logger->debug("valid: ", scalar @{$mgrCharts{valid}},
 257        " : ", join('/', @{$mgrCharts{valid}}));
 258
 259# the invalid list includes managers with invalid phases but we don't currently
 260# chart those
 261    $logger->debug("invalid: ", scalar @{$mgrCharts{invalid}},
 262        " : ", join('/', @{$mgrCharts{invalid}}));
 263
 264    # add some charts
 265
 266    # find the rows of interest for the pie charts
 267    my @categoryRows;
 268    my $usedRows = $sheet->UsedRange->Find(
 269        {   What            => "*",
 270            LookIn          => xlValues,
 271            LookAt          => xlPart,
 272            SearchDirection => xlPrevious,
 273            SearchOrder     => xlByRows
 274        }
 275    )->{Row};
 276    foreach my $row (3 .. $usedRows - 1) {
 277        push @categoryRows, $row if $sheet->Cells($row, 2)->{Value};
 278    }
 279
 280    # find the corner for our charts to start
 281    $logger->debug("invalid: ", scalar @{$mgrCharts{valid}});
 282    my $left       = $sheet->Range("A1:AI12")->Width;
 283    my $top        = $sheet->Range("A1:AI12")->Height;
 284    my $leftmargin = $left;
 285
 286    my $row = 2;
 287    my $col = 15;
 288    foreach my $mgr (sort @{$mgrCharts{valid}}) {
 289        $sheet->Cells($row, $col++)->{Value} = $mgr;
 290    }
 291    $sheet->Cells($row, $col--)->{Value} = ' ';
 292
 293    my $mgrChart = 0;
 294    foreach my $mgrCol (15 .. $col) {
 295        $logger->debug("total: ", $sheet->Cells($usedRows, $mgrCol)->{Value});
 296        next if ($sheet->Cells($usedRows, $mgrCol)->{Value} == 0);
 297        my $chart = $sheet->ChartObjects->Add(
 298            {   Left   => $left,
 299                Top    => $top,
 300                Width  => $mgrCharts{size},
 301                Height => $mgrCharts{size}
 302            }
 303        );
 304        my $source = $sheet->Cells($categoryRows[0], $mgrCol);
 305        foreach my $row (@categoryRows[1 .. $#categoryRows]) {
 306            $source = $excel->Union($source, $sheet->Cells($row, $mgrCol));
 307        }
 308        $chart->Chart->ChartWizard(
 309            {   Source    => $source,
 310                Gallery   => xlPie,
 311                Title     => $sheet->Cells(2, $mgrCol)->{Value},
 312                HasLegend => 0
 313            }
 314        );
 315        $chart->Chart->ChartTitle->Font->{Size} = 12;
 316        $chart->Chart->ApplyDataLabels(
 317            {   Type           => xlDataLabelsShowValue,
 318                HasLeaderLines => 0
 319            }
 320        );
 321        $chart->Chart->SeriesCollection(1)->DataLabels->{NumberFormat}
 322            = "0;-0;;@";
 323        $left += $mgrCharts{size} + $mgrCharts{gutter};
 324
 325        if (not(++$mgrChart % 5)) {
 326            $top += $mgrCharts{size} + $mgrCharts{gutter};
 327            $left = $leftmargin;
 328        }
 329    }
 330
 331    # Task 'Invalid Root Cause chart'
 332    $logger->debug("starting task invalid root cause chart...");
 333    $sheet = $workbook->Worksheets($tab{invalidRC_chart})
 334        or $logger->logdie("Can't open Excel worksheet: ",
 335        Win32::OLE->LastError());
 336
 337    # populate only the categories and reasons that have data
 338    $row          = 3;
 339    @categoryRows = ();
 340    foreach my $category (sort keys %{$totalDF{invalid}}) {
 341        my $categoryRow = $row++;
 342        push @categoryRows, $categoryRow;
 343        my $col     = 2;
 344        my $reasons = scalar keys %{$totalDF{invalid}{$category}};
 345        $sheet->Cells($categoryRow, $col)->{Value} = $category;
 346
 347        my $formula = '=SUM(R[1]C:R[' . $reasons . ']C)';
 348        $sheet->Cells($categoryRow, $col + 2)->{FormulaR1C1} = $formula;
 349        $sheet->Cells($categoryRow, $col + 4)->{FormulaR1C1} = $formula;
 350        $sheet->Cells($categoryRow, $col + 5)->{FormulaR1C1}
 351            = '=SUM(RC[-3], RC[-1])';
 352
 353        $col += 6;
 354        foreach my $manager (keys %team) {
 355            $sheet->Cells($categoryRow, $col++)->{FormulaR1C1} = $formula;
 356        }
 357        $sheet->Range(xl_range($categoryRow, 2, $categoryRow, $col - 1))
 358            ->Interior->{Color} = $color->Gray;
 359
 360        foreach my $reason (sort keys %{$totalDF{invalid}{$category}}) {
 361            my $reasonRow = $row++;
 362            my $col       = 3;
 363            $sheet->Cells($reasonRow, $col)->{Value} = $reason;
 364            $sheet->Cells($reasonRow, $col + 1)->{FormulaR1C1}
 365                = '=SUMPRODUCT((defectStatus<>"Cancelled")'
 366                . '*(Root_Cause_Phase=Phase_3)'
 367                . '*(Root_Cause_Category='
 368                . "R${categoryRow}C2)"
 369                . '*(Root_Cause_Reason=RC3))';
 370            $sheet->Cells($reasonRow, $col + 3)->{FormulaR1C1}
 371                = '=SUMPRODUCT((defectStatus<>"Cancelled")'
 372                . '*(Root_Cause_Phase=Phase_4)'
 373                . '*(Root_Cause_Category='
 374                . "R${categoryRow}C2)"
 375                . '*(Root_Cause_Reason=RC3))';
 376            $col += 5;
 377            my $formula
 378                = '=SUMPRODUCT((defectStatus<>"Cancelled")'
 379                . '*((Root_Cause_Phase=Phase_3)+(Root_Cause_Phase=Phase_4))'
 380                . '*(Root_Cause_Category='
 381                . "R${categoryRow}C2)"
 382                . '*(Root_Cause_Reason=RC3)*(STD=R2C))';
 383            foreach my $manager (keys %team) {
 384                $sheet->Cells($reasonRow, $col++)->{FormulaR1C1} = $formula;
 385            }
 386        }
 387    }
 388
 389    # grand totals
 390    $col      = 2;
 391    $usedRows = $row;
 392    my $formula = '=';
 393    $sheet->Cells($row, $col)->{Value} = 'Grand Total';
 394    foreach my $row (@categoryRows[0 .. $#categoryRows]) {
 395        $formula .= "R${row}C+";
 396    }
 397    $formula =~ s/\+$//;
 398    $sheet->Cells($row, $col + 2)->{FormulaR1C1} = $formula;
 399    $sheet->Cells($row, $col + 4)->{FormulaR1C1} = $formula;
 400    $col += 6;
 401    foreach my $manager (keys %team) {
 402        $sheet->Cells($row, $col++)->{FormulaR1C1} = $formula;
 403    }
 404    my $range = $sheet->Range(xl_range($row, 2, $row, $col - 1));
 405    $range->Font->{Bold}      = 'True';
 406    $range->Font->{Italic}    = 'True';
 407    $range->Interior->{Color} = $color->LightBlue;
 408
 409    # update chart series
 410    my $name = $sheet->{Name};
 411    my @x    = map {"'$name'!R" . $_ . "C2"} @categoryRows;
 412    my @y    = map {"'$name'!R" . $_ . "C7"} @categoryRows;
 413
 414    # deal with some brain damage in what excel likes in series syntax
 415    # i.e., it gets really annoyed by superfluous parens and spaces
 416    my @series = (
 417        '=SERIES("Invalid Root Causes"',
 418        (scalar @x == 1) ? @x : '(' . join(',', @x) . ')',
 419        (scalar @y == 1) ? @y : '(' . join(',', @y) . ')',
 420        '1)'
 421    );
 422    $formula = join ',', @series;
 423
 424    my $chart = $sheet->ChartObjects("Invalid Root Causes")->Chart;
 425    $chart->SeriesCollection(1)->{FormulaR1C1} = $formula;
 426
 427    # find the corner for our charts to start
 428    $logger->debug("invalid: ", scalar @{$mgrCharts{invalid}});
 429    $left       = $sheet->Range("A1:AC12")->Width;
 430    $top        = $sheet->Range("A1:AC12")->Height;
 431    $leftmargin = $left;
 432
 433    $row = 2;
 434    $col = 8;
 435    foreach my $mgr (sort @{$mgrCharts{invalid}}) {
 436        $sheet->Cells($row, $col++)->{Value} = $mgr;
 437    }
 438    $sheet->Cells($row, $col--)->{Value} = ' ';
 439
 440    $mgrChart = 0;
 441    foreach my $mgrCol (8 .. $col) {
 442        my $col = xl_off_to_col($mgrCol);
 443        $logger->debug("total: ", $sheet->Cells($usedRows, $mgrCol)->{Value});
 444        next if ($sheet->Cells($usedRows, $mgrCol)->{Value} == 0);
 445        my $chart = $sheet->ChartObjects->Add(
 446            {   Left   => $left,
 447                Top    => $top,
 448                Width  => $mgrCharts{size},
 449                Height => $mgrCharts{size}
 450            }
 451        );
 452        my $source = $sheet->Cells($categoryRows[0], $mgrCol);
 453        foreach my $row (@categoryRows[1 .. $#categoryRows]) {
 454            $source = $excel->Union($source, $sheet->Cells($row, $mgrCol));
 455        }
 456        $chart->Chart->ChartWizard(
 457            {   Source    => $source,
 458                Gallery   => xlPie,
 459                Title     => $sheet->Cells(2, $mgrCol)->{Value},
 460                HasLegend => 0
 461            }
 462        );
 463        $chart->Chart->ChartTitle->Font->{Size} = 12;
 464        $chart->Chart->ApplyDataLabels(
 465            {   Type           => xlDataLabelsShowValue,
 466                HasLeaderLines => 0
 467            }
 468        );
 469        $chart->Chart->SeriesCollection(1)->DataLabels->{NumberFormat}
 470            = "0;-0;;@";
 471        $left += $mgrCharts{size} + $mgrCharts{gutter};
 472
 473        if (not(++$mgrChart % 5)) {
 474            $top += $mgrCharts{size} + $mgrCharts{gutter};
 475            $left = $leftmargin;
 476        }
 477    }
 478
 479    # refresh the pivot tables
 480    $workbook->RefreshAll;
 481
 482    # TASK 'Invalid root causes'
 483    # add a worksheet for the invalid root causes
 484    $logger->debug("starting task invalid root causes...");
 485    $sheet = $workbook->Worksheets('Invalid root causes')
 486        or $logger->logdie("Can't open Excel worksheet: ",
 487        Win32::OLE->LastError());
 488
 489    my %rcInvalid = (
 490        'Invalid Phases'     => \@invalidPhases,
 491        'Invalid Categories' => \@invalidCategories,
 492        'Invalid Reasons'    => \@invalidReasons,
 493    );
 494
 495    # which columns are we interested in?
 496    $logger->debug("which columns are we interested in...");
 497    my $usedCols = $sheet->UsedRange->Find(
 498        {   What            => "*",
 499            LookIn          => xlValues,
 500            LookAt          => xlPart,
 501            SearchDirection => xlPrevious,
 502            SearchOrder     => xlByColumns
 503        }
 504    )->{Column};
 505    $row = 1;
 506    my @headers     = ();
 507    my %headerIndex = ();
 508    foreach my $column (1 .. $usedCols) {
 509        my $hdr
 510            = $sheet->Cells($row, $column)->{Value} eq 'STD'
 511            ? 'User 4'
 512            : $sheet->Cells($row, $column)->{Value};
 513        $headerIndex{$hdr} = $column;
 514        push @headers, $hdr;
 515    }
 516    if (exists $headerIndex{'User 4'}) {
 517        $headerIndex{STD} = $headerIndex{'User 4'};
 518    }
 519    $logger->debug("used columns $usedCols");
 520
 521    my @rcHdrs
 522        = ('Root Cause Phase', 'Root Cause Category', 'Root Cause Reason');
 523    foreach
 524        my $field ('Invalid Phases', 'Invalid Categories', 'Invalid Reasons')
 525    {
 526        $row++;
 527
 528        # scribble a header row
 529        $logger->debug("processing $field...");
 530        $sheet->Cells($row, 1)->{Value} = $field;
 531        foreach my $header (@rcHdrs) {
 532            $sheet->Cells($row, $headerIndex{$header})->{Value} = $header;
 533        }
 534        my $range = $sheet->Range(xl_range($row, 1, $row, $usedCols));
 535        $range->Font->{Bold}      = 'True';
 536        $range->Interior->{Color} = $color->MediumBlue;
 537
 538        $logger->debug("write out the section values...");
 539
 540        # save the section starting row and then pump out the section
 541        # !! it would be better if I wrote the whole block or at least
 542        #    a whole row at a time instead of a cell at a time
 543        my $sectionStart = $row;
 544        foreach my $invalidRC (@{$rcInvalid{$field}}) {
 545            $row++;
 546            my @cells = ();
 547            foreach my $header (@headers) {
 548                push @cells, $invalidRC->[$columnIndex{$header}];
 549            }
 550            $sheet->Range(xl_range($row, 1, $row, $usedCols))->{Value}
 551                = [@cells];
 552        }
 553
 554        $logger->debug("sort the section...");
 555
 556        # sort the section by STD, RC Phase, RC Category, RC Reason
 557        $sheet->Sort->SortFields->Clear;
 558        for my $sortCol (
 559            'STD',
 560            'Root Cause Phase',
 561            'Root Cause Category',
 562            'Root Cause Reason'
 563            )
 564        {
 565            $sheet->Sort->SortFields->Add(
 566                {   Key => $sheet->Range(
 567                        $sheet->Cells($sectionStart, $headerIndex{$sortCol}),
 568                        $sheet->Cells($row,          $headerIndex{$sortCol})
 569                    ),
 570                    Order      => xlAscending,
 571                    SortOn     => xlSortOnValues,
 572                    DataOption => xlSortNormal
 573                }
 574            );
 575        }
 576        $sheet->Sort->SetRange(
 577            $sheet->Range(
 578                $sheet->Cells($sectionStart, $headerIndex{'STD'}),
 579                $sheet->Cells($row, $headerIndex{'Root Cause Reason'})
 580            )
 581        );
 582        $sheet->Sort->{Header} = xlYes;
 583        $sheet->Sort->Apply;
 584
 585        $logger->debug("create and outline group...");
 586
 587        # create an outline group for the section
 588        $sheet->Range("$sectionStart:$row")->Group;
 589
 590        # to make outlining prettier, scribble trailing (or summary) row
 591        $row++;
 592        $sheet->Cells($row, 1)->{Value} = $field;
 593        foreach my $header (@rcHdrs) {
 594            $sheet->Cells($row, $headerIndex{$header})->{Value} = $header;
 595        }
 596        $range = $sheet->Range($sheet->Cells($row, 1),
 597            $sheet->Cells($row, $usedCols));
 598        $range->Font->{Bold}                       = 'True';
 599        $range->Borders(xlEdgeBottom)->{LineStyle} = xlContinuous;
 600        $range->Interior->{Color}                  = $color->LightBlue;
 601    }
 602
 603    # collapse the outline to the first level
 604    $sheet->Outline->ShowLevels({RowLevels => 1});
 605
 606    #    # expand a group in the outline (leaving this code in as an example)
 607    #    $sheet->Rows(3)->{ShowDetail} = 1;
 608
 609    # Task 'Overview'
 610    # open worksheet for the Overview
 611    $logger->debug("starting task Overview...");
 612    $sheet = $workbook->Worksheets('Overview')
 613        or $logger->logdie("Can't open Excel worksheet: ",
 614        Win32::OLE->LastError());
 615
 616    my @ovStatus = ('STD', 'Sev 1', 'Sev 2', 'Sev 3', 'Cancelled', 'Total');
 617    my @ovValidity = qw(Valid Invalid %Valid);
 618    my @ovRootcause     = qw(Phase Category Reason);
 619    my @overviewHeaders = (@ovStatus, @ovValidity, @ovRootcause);
 620    my $lWidth          = scalar @ovStatus;
 621    my $cWidth          = scalar @ovValidity;
 622    my $rWidth          = scalar @ovRootcause;
 623    my $tWidth          = scalar @overviewHeaders;
 624    my $tRow            = $row = 2;
 625    my $lCol            = 2;
 626    my $rCol            = $lCol + $tWidth - 1;
 627    $col = $lCol;
 628
 629    $range = $sheet->Range(xl_range($row, $lCol, $row, $rCol));
 630    $range->{HorizontalAlignment} = xlHAlignLeft;
 631    $range->Font->{Bold}          = 'True';
 632    $range->Font->{Color}         = $color->White;
 633    $range->Interior->{Color}     = $color->DarkBlue;
 634    $sheet->Range(
 635        xl_range($row, $lCol + $lWidth, $row, $lCol + $lWidth + $cWidth - 1))
 636        ->Interior->{Color} = $color->DarkGreen;
 637    $sheet->Range(xl_range($row, $lCol + $lWidth + $cWidth, $row, $rCol))
 638        ->Interior->{Color} = $color->DarkBrown;
 639    $sheet->Cells($row, $lCol)->{Value} = 'Defects by STD and Severity';
 640    $sheet->Cells($row, $lCol + $lWidth)->{Value} = 'Root Cause Validity';
 641    $sheet->Cells($row, $lCol + $lWidth + $cWidth)->{Value} = 'Invalid Area';
 642
 643    $row++;
 644
 645    $range = $sheet->Range(xl_range($row, $lCol, $row, $rCol));
 646    $range->Font->{Bold}      = 'True';
 647    $range->Interior->{Color} = $color->MediumBlue;
 648    foreach my $header (@overviewHeaders) {
 649        $sheet->Cells($row, $col++)->{Value} = $header;
 650    }
 651    $row++;
 652
 653    foreach my $teamName (sort keys %team) {
 654        if ($team{$teamName}{totalDF}) {
 655            my $col = $lCol;
 656            $sheet->Range(
 657                xl_range($row, $lCol, $row, $lCol + $lWidth + $cWidth - 2))
 658                ->Interior->{Color} = $color->LightBlue
 659                if ($row % 2);
 660            $sheet->Cells($row, $col)->{Value} = $teamName;
 661            $sheet->Cells($row, ++$col)->{Value}
 662                = $team{$teamName}{'Severity 1'};
 663            $sheet->Cells($row, ++$col)->{Value}
 664                = $team{$teamName}{'Severity 2'};
 665            $sheet->Cells($row, ++$col)->{Value}
 666                = $team{$teamName}{'Severity 3'};
 667            $sheet->Cells($row, ++$col)->{Value}
 668                = $team{$teamName}{'Cancelled'};
 669            $sheet->Cells($row, ++$col)->{Value} = $team{$teamName}{totalDF};
 670
 671            $sheet->Cells($row, ++$col)->{Value} = $team{$teamName}{valid};
 672            $sheet->Cells($row, ++$col)->{Value}
 673                = $team{$teamName}{invalid}{total};
 674            $sheet->Cells($row, ++$col)->{FormulaR1C1}
 675                = '=IFERROR(RC[-2]/(RC[-2]+RC[-1]), "N/A")';
 676
 677            $sheet->Range(
 678                xl_range($row, $lCol + $lWidth + $cWidth, $row, $rCol))
 679                ->Interior->{Color} = $color->LightBrown
 680                if ($row % 2);
 681            $sheet->Cells($row, ++$col)->{Value}
 682                = $team{$teamName}{invalid}{rcPhase};
 683            $sheet->Cells($row, ++$col)->{Value}
 684                = $team{$teamName}{invalid}{rcCategory};
 685            $sheet->Cells($row, ++$col)->{Value}
 686                = $team{$teamName}{invalid}{rcReason};
 687
 688            $row++;
 689        }
 690    }
 691
 692    $range = $sheet->Range(xl_range($row, $lCol, $row, $rCol));
 693    $range->Font->{Bold}                       = 'True';
 694    $range->Font->{Italic}                     = 'True';
 695    $range->Interior->{Color}                  = $color->MediumBlue;
 696    $range->Borders(xlEdgeTop)->{LineStyle}    = xlContinuous;
 697    $range->Borders(xlEdgeBottom)->{LineStyle} = xlContinuous;
 698
 699    $col = $lCol;
 700    $sheet->Cells($row, $col)->{Value} = 'Grand Total';
 701    $sheet->Cells($row, ++$col)->{Value} = $totalDF{'Severity 1'};
 702    $sheet->Cells($row, ++$col)->{Value} = $totalDF{'Severity 2'};
 703    $sheet->Cells($row, ++$col)->{Value} = $totalDF{'Severity 3'};
 704    $sheet->Cells($row, ++$col)->{Value} = $totalDF{'Cancelled'};
 705    $sheet->Cells($row, ++$col)->{Value} = $grandTotal;
 706
 707    $sheet->Range(
 708        xl_range($tRow + 1, $lCol + $lWidth - 1, $row, $lCol + $lWidth - 1))
 709        ->Borders(xlEdgeRight)->{LineStyle} = xlContinuous;
 710    $sheet->Range(
 711        xl_range(
 712            $tRow + 1,
 713            $lCol + $lWidth + $cWidth - 1,
 714            $row,
 715            $lCol + $lWidth + $cWidth - 1
 716        )
 717    )->Borders(xlEdgeRight)->{LineStyle} = xlContinuous;
 718
 719    for (1 .. $cWidth + $rWidth) {
 720        my $formula = '=SUM(R[' . ($tRow + 2 - $row) . ']C:R[-1]C)';
 721        $sheet->Cells($row, ++$col)->{FormulaR1C1} = $formula;
 722    }
 723    $sheet->Cells($row, $lCol + $lWidth + $cWidth - 1)->{FormulaR1C1}
 724        = '=RC[-2]/(RC[-2]+RC[-1])';
 725
 726    $sheet->Range(xl_range($tRow, $lCol, $row, $rCol))->Font->{Name}
 727        = 'Calibri';
 728    $sheet->Range(xl_range($tRow, $lCol, $row, $rCol))->Font->{Size} = 11;
 729
 730    # use conditional format for %valid
 731    $range = $sheet->Range(
 732        xl_range(
 733            $tRow + 2,
 734            $lCol + $lWidth + $cWidth - 1,
 735            $row - 1,
 736            $lCol + $lWidth + $cWidth - 1
 737        )
 738    );
 739    $range->FormatConditions->AddDatabar;
 740    $range->FormatConditions($range->FormatConditions->{Count})->{ShowValue}
 741        = 1;
 742    $range->FormatConditions($range->FormatConditions->{Count})
 743        ->SetFirstPriority;
 744    $range->FormatConditions(1)
 745        ->MinPoint->Modify({newtype => xlConditionValueLowestValue});
 746    $range->FormatConditions(1)
 747        ->MaxPoint->Modify({newtype => xlConditionValueHighestValue});
 748    $range->FormatConditions(1)->BarColor->{Color}        = 13012579;
 749    $range->FormatConditions(1)->BarColor->{TintAndShade} = 0;
 750
 751    # Task 'Features'
 752    # open worksheet for the Feature mapping
 753    $logger->debug("starting task Features...");
 754    $sheet = $workbook->Worksheets('Feature mapping')
 755        or $logger->logdie("Can't open Excel worksheet: ",
 756        Win32::OLE->LastError());
 757
 758    $usedRows = $sheet->UsedRange->Find(
 759        {   What            => "*",
 760            LookIn          => xlValues,
 761            LookAt          => xlPart,
 762            SearchDirection => xlPrevious,
 763            SearchOrder     => xlByRows
 764        }
 765    )->{Row};
 766    $usedCols = $sheet->UsedRange->Find(
 767        {   What            => "*",
 768            LookIn          => xlValues,
 769            LookAt          => xlPart,
 770            SearchDirection => xlPrevious,
 771            SearchOrder     => xlByColumns
 772        }
 773    )->{Column};
 774
 775    # build the list mapping features to scope items
 776    my $feature_ref
 777        = $sheet->Range(xl_range(2, 1, $usedRows, $usedCols))->{Value};
 778
 779    my %feature;
 780    foreach my $row (@{$feature_ref}) {
 781        if (@$row[0]) {
 782            $name = @$row[0];
 783            push @{$feature{names}}, $name;
 784            next;
 785        }
 786        else {
 787            foreach my $item (@{$row}) {
 788                if ($item) {
 789                    push @{$feature{name}{$name}{scopes}}, $item;
 790                }
 791            }
 792        }
 793    }
 794
 795    # get the scope counts from the scope pivot
 796    my $scopeSheet = $workbook->Worksheets('Defects by Scope ID-CR#')
 797        or $logger->logdie("Can't open Excel worksheet: ",
 798        Win32::OLE->LastError());
 799
 800    $usedRows = $scopeSheet->UsedRange->Find(
 801        {   What            => "*",
 802            LookIn          => xlValues,
 803            LookAt          => xlPart,
 804            SearchDirection => xlPrevious,
 805            SearchOrder     => xlByRows
 806        }
 807    )->{Row};
 808
 809    my $scope_ref
 810        = $scopeSheet->Range(xl_range(4, 1, $usedRows - 1, 2))->{Value};
 811    my %scopeID = map {$_->[0] => $_->[1]} @{$scope_ref};
 812
 813    # process each scope item and assign to a feature
 814
 815    foreach my $fn (@{$feature{names}}) {
 816        my $pattern = join '|', @{$feature{name}{$fn}{scopes}};
 817        $feature{name}{$fn}{pattern} = qr/$pattern/i;
 818    }
 819
 820    my %featureSummary;
 821    foreach my $scope (keys %scopeID) {
 822        my $matched = 0;
 823        foreach my $fn (@{$feature{names}}) {
 824            if ($scope =~ /$feature{name}{$fn}{pattern}/) {
 825                $featureSummary{$fn}{$scope} = $scopeID{$scope};
 826                $matched = 1, last;
 827            }
 828        }
 829        if (not $matched) {
 830            $featureSummary{Others}{$scope} = $scopeID{$scope};
 831        }
 832    }
 833
 834    # update the "Defect by Feature" sheet
 835    $logger->debug("starting task Defect by Feature...");
 836    $sheet = $workbook->Worksheets('Defects by Feature')
 837        or $logger->logdie("Can't open Excel worksheet: ",
 838        Win32::OLE->LastError());
 839
 840    my @featureRows;
 841    $row = 1;
 842    foreach my $fn (@{$feature{names}}, 'Others') {
 843        next if (not exists $featureSummary{$fn});
 844        my $featureRow = ++$row;
 845        push @featureRows, $featureRow;
 846        if ($fn eq 'Others') {
 847            $sheet->Cells($featureRow, 1)->{Value}
 848                = 'Others (non-feature, CR, deferred, blank, etc.)';
 849        }
 850        else {
 851            $sheet->Cells($featureRow, 1)->{Value} = $fn;
 852        }
 853        $range = $sheet->Range(xl_range($featureRow, 1, $featureRow, 4));
 854        $range->Font->{Bold}      = 'True';
 855        $range->Interior->{Color} = $color->Gray;
 856
 857        foreach my $scope (sort keys %{$featureSummary{$fn}}) {
 858            $sheet->Cells(++$row, 2)->{Value} = $scope;
 859            $sheet->Cells($row,   3)->{Value} = $featureSummary{$fn}{$scope};
 860        }
 861
 862        $sheet->Cells($featureRow, 4)->{FormulaR1C1}
 863            = '=SUM(R[+1]C[-1]:R[+' . ($row - $featureRow) . ']C[-1])';
 864    }
 865    $sheet->Cells(++$row, 1)->{Value}       = 'Grand Total';
 866    $sheet->Cells($row,   4)->{FormulaR1C1} = '=SUM(R2C:R[-1]C';
 867
 868    $range = $sheet->Range(xl_range($row, 1, $row, 4));
 869    $range->Font->{Bold}      = 'True';
 870    $range->Font->{Italic}    = 'True';
 871    $range->Interior->{Color} = $color->LightBlue;
 872
 873    # update chart series
 874    $name = $sheet->{Name};
 875
 876    @x = map {"'$name'!R" . $_ . "C1"} @categoryRows;
 877    @y = map {"'$name'!R" . $_ . "C4"} @categoryRows;
 878
 879    # deal with some brain damage in what excel likes in series syntax
 880    # i.e., it gets really annoyed by superfluous parens and spaces
 881    @series = (
 882        '=SERIES("Defects by Feature"',
 883        (scalar @x == 1) ? @x : '(' . join(',', @x) . ')',
 884        (scalar @y == 1) ? @y : '(' . join(',', @y) . ')',
 885        '1)'
 886    );
 887    $formula = join ',', @series;
 888
 889    $chart = $sheet->ChartObjects(1)->Chart;
 890    $chart->SeriesCollection(1)->{FormulaR1C1} = $formula;
 891
 892    $logger->debug("finish up and save a snapshot...");
 893
 894    # save a snapshot for today
 895    my $snapShot = saveSnapshot($workbook, $rcReport, 'Root Cause summary');
 896
 897    # be nice and close the patient
 898    $workbook->Close();
 899    $excel->Quit();
 900
 901    #    $Data::Dumper::Terse = 1;
 902    #    $logger->debug(Dumper(%team, %mgrCharts, %totalDF));
 903
 904    return (\%team, \%totalDF, \%mgrCharts, $grandTotal);
 905}
 906
 907
 908sub getRootCauseMap {
 909    my $workbook = shift;
 910
 911    my $wbName = 'Reason mapping';
 912    my $logger = get_logger();
 913
 914    # open worksheet for the root cause mapping
 915    my $sheet = $workbook->Worksheets($wbName)
 916        or $logger->logdie("Can't open Excel worksheet: $wbName",
 917        Win32::OLE->LastError());
 918
 919    my $usedRows = $sheet->UsedRange->Find(
 920        {   What            => "*",
 921            LookIn          => xlValues,
 922            LookAt          => xlPart,
 923            SearchDirection => xlPrevious,
 924            SearchOrder     => xlByRows
 925        }
 926    )->{Row};
 927
 928    # build the list mapping categories to reason items
 929    my $rc_ref = $sheet->Range(xl_range(2, 1, $usedRows, 2))->{Value};
 930
 931    my %rootCause = (
 932        Phase => [
 933            'Phase 3: Design, Development and Pre-Production Testing',
 934            'Phase 4: Install and Production Readiness Test',
 935        ],
 936    );
 937
 938    my @group;
 939    my $newGroup = 1;
 940    foreach my $row (@{$rc_ref}) {
 941        my ($category, $reason) = @{$row};
 942        if ($category) {
 943            if ($newGroup) {
 944                $newGroup = 0;
 945                @group    = ();
 946            }
 947            push @{$rootCause{Categories}}, $category;
 948            push @group, $category;
 949        }
 950        else {
 951            push @{$rootCause{Reasons}}, $reason;
 952            foreach my $cat (@group) {
 953                push @{$rootCause{Category}{$cat}}, $reason;
 954            }
 955            $newGroup = 1;
 956        }
 957    }
 958    return %rootCause;
 959}
 960
 961
 962sub rtmByReqReport {
 963    my $tdc         = shift;
 964    my $filters_ref = shift;
 965    my $report      = shift;
 966
 967    my $logger = get_logger();
 968
 969    my %testCoverage;
 970    foreach my $filter (@$filters_ref) {
 971        my $reqFactory = $tdc->ReqFactory;
 972        my $reqFilter  = $reqFactory->Filter;
 973
 974        my @pathElements = split /\\/, $filter;
 975        my $parent = $reqFactory->Item(0);
 976
 977        foreach my $element (@pathElements) {
 978            my @reqList
 979                = in $reqFactory->Find($parent->ID, 'RQ_REQ_NAME', $element,
 980                16);
 981            (my $reqID = $reqList[0]) =~ s/,.*//;
 982            $parent = $reqFactory->Item($reqID);
 983        }
 984        next if (not defined $parent);
 985
 986        my @requirements;
 987        @requirements = getReqChildren($reqFactory, $parent, \@requirements);
 988
 989        foreach my $requirement (@requirements) {
 990            my @tests = in $requirement->GetCoverlist;
 991            foreach my $test (@tests) {
 992
 993                # I don't understand why this is, but some tests don't have a
 994                # Subject field defined, so I have to ignore those.
 995                # TODO: Is there any way to get the QC folder path for those?
 996                if (not defined $test->Field('TS_SUBJECT')) {
 997                    $logger->error('undefined subject with requirement ',
 998                        $requirement->Name, ' and test ', $test->Name);
 999                }
1000                else {
1001                    my $path = $test->Field('TS_SUBJECT')->Path . "\\"
1002                        . $test->Name;
1003                    $testCoverage{$path}->{Folder}
1004                        = $test->Field('TS_SUBJECT')->Path;
1005                    $testCoverage{$path}->{Name} = $test->Name;
1006                    $testCoverage{$path}->{Description}
1007                        = $test->Field('TS_DESCRIPTION');
1008                    push @{$testCoverage{$path}->{Requirements}},
1009                        $requirement->Field('RQ_USER_05');
1010                }
1011            }
1012        }
1013        $logger->debug("Filtered requirements found: ", scalar @requirements);
1014    }
1015
1016    my @coverage;
1017    foreach my $test (keys %testCoverage) {
1018        push @coverage,
1019            [
1020            $testCoverage{$test}->{Folder},
1021            $testCoverage{$test}->{Name},
1022            $testCoverage{$test}->{Description},
1023            join("\n", @{$testCoverage{$test}->{Requirements}})
1024            ];
1025    }
1026
1027    rtmReport(\@coverage, $report);
1028
1029    return scalar(@coverage);
1030}
1031
1032
1033sub rtmByTestLabReport {
1034    my $tdc         = shift;
1035    my $filters_ref = shift;
1036    my $report      = shift;
1037    my $rpt_del_req = shift;
1038    my $cqc         = shift;
1039    my $project     = shift;
1040
1041    my $logger = get_logger();
1042    
1043    my @testSets;
1044    foreach my $folder (@{$project->{folders}->{folder}}) {
1045        push @testSets, getFolderTestSets($tdc, $folder);
1046    }
1047    $logger->info('Total test sets found: ', scalar @testSets);
1048    
1049    my $progress = 0;
1050    my $totalTC  = 0;
1051    my $totalTS  = scalar(@testSets);
1052    
1053    my %tcField = mapTCFields($cqc);
1054    
1055    my (@covered, @notcovered);
1056    foreach my $ts (@testSets) {
1057        #
1058        # Get all the test instances in the project node
1059        #
1060        $progress++;
1061        my $tsFactory       = $ts->TSTestFactory;
1062        my @testInstances   = in $tsFactory->NewList('');
1063        my $tsCount         = scalar(@testInstances);
1064        my $tsArea          = $ts->TestSetFolder->Name;
1065        my $tsSubArea       = $ts->Name;
1066        my $tcInstance      = 0;
1067
1068        $logger->debug("($progress/$totalTS) test instances in: ",
1069            $tsArea, "\\", $tsSubArea, " : ", $tsCount);
1070        $totalTC += $tsCount;
1071
1072        if ($tsCount) {
1073            # Look at each test instance and collect its details
1074            foreach my $tc (@testInstances) {
1075                my $tn = $tc->Name;
1076                if ($tc->Test->HasCoverage) {
1077                    push @covered, $tc;
1078                }
1079                else {
1080                    push @notcovered, $tc;
1081                }
1082            }
1083        }
1084    }
1085    $logger->debug("covered: ",      scalar(@covered),
1086                   " not covered: ", scalar(@notcovered));
1087
1088    my @coverage;
1089
1090    my $tc = 0;
1091    foreach my $test (@covered) {
1092        my @coverList = in $test->Test->GetCoverList;
1093        my @requirements;
1094        foreach my $requirement (@coverList) {
1095            if (not $requirement->Field('RQ_USER_03')) {
1096                $logger->warn(
1097                    'Unknown status in requirement ',
1098                    $requirement->Name,
1099                    ' for test ',
1100                    $test->Test->Field('TS_SUBJECT')->Path,
1101                    '\\',
1102                    $test->Test->Name
1103                );
1104            }
1105
1106            # we don't want to include any requirements that have been
1107            # deleted so we need to check that status first
1108            if (   ($requirement->Field('RQ_USER_03'))
1109                && ($requirement->Field('RQ_USER_03') eq 'Deleted'))
1110            {
1111                $logger->warn(
1112                    'Deleted requirement ',
1113                    $requirement->Name,
1114                    ' for test ',
1115                    $test->Test->Field('TS_SUBJECT')->Path,
1116                    '\\',
1117                    $test->Test->Name
1118                );
1119            }
1120            else {
1121
1122               # we don't want the ReqPRO tag in the requirement name
1123               # so we use the Requirement Name field in RQ_USER_05 but
1124               # sometimes we see an anomaly in the requirements where
1125               # the field will be blank, so we fallback to the Name field
1126               # in those cases.
1127                if ($requirement->Field('RQ_USER_05')) {
1128                    push @requirements, $requirement->Field('RQ_USER_05');
1129                }
1130                else {
1131                    # QC requirements are now (7/11/11) being populated in 
1132                    # such a way that this is almost always true. So for now
1133                    # I'm commenting out this warning message
1134#                    $logger->warn(
1135#                        'Null requirement name field for ',
1136#                        $test->Test->Field('TS_SUBJECT')->Path,
1137#                        '\\', $test->Test->Name,
1138#                        ', ReqPro tag name: ', $requirement->Field('RQ_USER_06'),
1139#                        ', RQ_REQ_NAME: ', $requirement->Field('RQ_REQ_NAME'),
1140#                        ', using: ', $requirement->Name
1141#                    );
1142                    push @requirements, $requirement->Name;
1143                }
1144            }
1145        }
1146
1147        # we should get here with a requirements list but I suppose it's
1148        # possible that we could end up with an empty list if all the
1149        # requirements for this test case have been deleted, so we need
1150        # to check for an empty list
1151        if (@requirements) {
1152            push @coverage,
1153                [
1154                $test->Test->Field('TS_SUBJECT')->Path,
1155                $test->Test->Name,
1156                getDescription($test, 'Lab'),
1157                join("\n", @requirements),
1158                ];
1159        }
1160        else {
1161            $logger->warn(
1162                'Empty requirement set for test ',
1163                $test->Test->Field('TS_SUBJECT')->Path,
1164                '\\', $test->Test->Name
1165            );
1166        }
1167        unless (++$tc % 100) {
1168            $logger->debug("__ processing test case $tc");
1169        }
1170    }
1171    $logger->debug("Filtered tests found: ", scalar @coverage);
1172
1173    rtmReport(\@coverage, $report);
1174
1175    return scalar(@coverage);
1176}
1177
1178
1179sub rtmByTestReport {
1180    my $tdc         = shift;
1181    my $filters_ref = shift;
1182    my $report      = shift;
1183    my $rpt_del_req = shift;
1184
1185    my $logger = get_logger();
1186
1187    my @coverage;
1188    foreach my $filter (@$filters_ref) {
1189
1190        # filter from the current folder using a cross-filter to
1191        # select only those tests which have an associated requirement
1192
1193        my $tsFactory = $tdc->TestFactory;
1194        my $tsFilter  = $tsFactory->Filter;
1195
1196        my $rqFactory = $tdc->ReqFactory;
1197        my $rqFilter  = $rqFactory->Filter;
1198
1199        $tsFilter->SetProperty('Filter', 'TS_SUBJECT', $filter);
1200        $rqFilter->SetProperty('Filter', 'RQ_REQ_ID',  '> 0');
1201        $tsFilter->SetXFilter('TEST-REQ', "TRUE", $rqFilter->Text);
1202
1203        my @tsList = in $tsFilter->NewList();
1204        $logger->debug("Total tests found: ", scalar(@tsList));
1205
1206        my $tc = 0;
1207        foreach my $test (@tsList) {
1208            my @coverList = in $test->GetCoverList;
1209            my @requirements;
1210            foreach my $requirement (@coverList) {
1211                if (not $requirement->Field('RQ_USER_03')) {
1212                    $logger->warn(
1213                        'Unknown status in requirement ',
1214                        $requirement->Name,
1215                        ' for test ',
1216                        $test->Field('TS_SUBJECT')->Path,
1217                        '\\',
1218                        $test->Name
1219                    );
1220                }
1221
1222                # we don't want to include any requirements that have been
1223                # deleted so we need to check that status first
1224                if (   ($requirement->Field('RQ_USER_03'))
1225                    && ($requirement->Field('RQ_USER_03') eq 'Deleted'))
1226                {
1227                    $logger->warn(
1228                        'Deleted requirement ',
1229                        $requirement->Name,
1230                        ' for test ',
1231                        $test->Field('TS_SUBJECT')->Path,
1232                        '\\',
1233                        $test->Name
1234                    );
1235                }
1236                else {
1237
1238                   # we don't want the ReqPRO tag in the requirement name
1239                   # so we use the Requirement Name field in RQ_USER_05 but
1240                   # sometimes we see an anomaly in the requirements where
1241                   # the field will be blank, so we fallback to the Name field
1242                   # in those cases.
1243                    if ($requirement->Field('RQ_USER_05')) {
1244                        push @requirements, $requirement->Field('RQ_USER_05');
1245                    }
1246                    else {
1247                        $logger->warn(
1248                            'Null requirement name field for ',
1249                            $test->Field('TS_SUBJECT')->Path,
1250                            '\\', $test->Name
1251                        );
1252                        push @requirements, $requirement->Name;
1253                    }
1254                }
1255            }
1256
1257            # we should get here with a requirements list but I suppose it's
1258            # possible that we could end up with an empty list if all the
1259            # requirements for this test case have been deleted, so we need
1260            # to check for an empty list
1261            if (@requirements) {
1262                push @coverage,
1263                    [
1264                    $test->Field('TS_SUBJECT')->Path,
1265                    $test->Name,
1266                    getDescription($test, 'Plan'),
1267                    join("\n", @requirements),
1268                    ];
1269            }
1270            else {
1271                $logger->warn(
1272                    'Empty requirement set for test ',
1273                    $test->Field('TS_SUBJECT')->Path,
1274                    '\\', $test->Name
1275                );
1276            }
1277            unless (++$tc % 100) {
1278                $logger->debug("__ processing test case $tc");
1279            }
1280        }
1281    }
1282    $logger->debug("Filtered tests found: ", scalar @coverage);
1283
1284    rtmReport(\@coverage, $report);
1285
1286    return scalar(@coverage);
1287}
1288
1289
1290sub rtmReport {
1291    my $coverage = shift;
1292    my $report   = shift;
1293
1294    my $logger = get_logger();
1295
1296    # set up the report output
1297    $logger->debug("creating spreadsheet...");
1298    my $excel = Win32::OLE->new('Excel.Application', 'Quit')
1299        or $logger->logdie("cannot start Excel: ", Win32::OLE->LastError());
1300
1301    # avoid excessive Excel dialogs
1302    $excel->{DisplayAlerts} = 0;
1303    $excel->{Visible}       = 0;
1304
1305    my $workbook = $excel->Workbooks->Add
1306        or $logger->logdie("Can't create Excel workbook",
1307        Win32::OLE->LastError());
1308
1309    my $sheet = $workbook->Worksheets("Sheet1");
1310
1311    # write the covered requirements if we have any
1312    if (scalar @$coverage) {
1313        $logger->debug("Writing ", scalar(@$coverage), " tests to report");
1314        my $columns = scalar @{$coverage->[0]};
1315        my $rows    = scalar @$coverage;
1316        my $row     = 1;
1317        $sheet->Rows($row)->Font->{Bold}    = 'True';
1318        $sheet->Range('A:A')->{ColumnWidth} = 75;
1319        $sheet->Range('B:B')->{ColumnWidth} = 30;
1320        $sheet->Range('C:C')->{ColumnWidth} = 100;
1321        $sheet->Range('D:D')->{ColumnWidth} = 40;
1322        $sheet->Range($sheet->Cells($row, 1), $sheet->Cells($row, $columns))
1323            ->{Value} = ['TC Path', 'Name', 'Description', 'Requirement'];
1324
1325       # FIXME - why do I have to write this row by row? 
1326       # I don't know the underlying cause but when I pass it the entire
1327       # array it stops after 258 rows. If I write row by row it usually 
1328       # succeeds and doesn't take an inordinate amount of time. But even
1329       # writing row by row doesn't always work... sometimes it fails to
1330       # write one or more of the cells. What's strange is that it's not
1331       # a fatal error and there isn't an apparent reason for the failure.
1332       # The record that fails is larger than the others but not huge and
1333       # certainly within excel's limits.
1334        foreach my $tc (@$coverage) {
1335#            say Devel::Size::total_size($tc);
1336            $row++;
1337            my $col = 1;
1338            foreach my $cellvalue (@$tc) {
1339                $sheet->Cells($row, $col++)->{Value} = $cellvalue;
1340                if (Win32::OLE->LastError()) {
1341                    $logger->warn(Win32::OLE->LastError(),
1342                    " at row $row, col ", $col-1);
1343                }
1344            }
1345            unless ($row % 100) {
1346                $logger->debug("__ processing test case $row");
1347            }
1348        }
1349        saveSnapshot($workbook, $report, 'Sheet1');
1350    }
1351    else {
1352        $logger->warn(
1353            "No covered requirements found; no spreadsheet created.");
1354    }
1355    $workbook->Close();
1356    $excel->Quit();
1357}
1358
1359
1360# -*- stubs -*-
1361
13621;    # Magic true value required at end of module
1363
1364
1365__END__