/CQC/Reports.pm

# -*-Perl-*-



package CQC::Reports;



# use perl to generate Quality Center reports for OSD projects



use 5.010_000;

use feature qw(say);



use strict;

use warnings;



use vars qw($VERSION);

our $VERSION = '0.01.01';



# Task 'Export'

use Exporter qw(import);

our @EXPORT_OK

    = qw( rootCauseReport rtmByReqReport rtmByTestReport rtmByTestLabReport rtmReport );

our %EXPORT_TAGS = (

    ALL => [qw( rootCauseReport rtmByReqReport rtmByTestReport rtmByTestLabReport rtmReport )]);



use Data::Dumper;

use Log::Log4perl qw(get_logger :nowarn);

use Date::Format;

use Storable;

#use Devel::Size;



use Win32::OLE qw(in valof);

use Win32::OLE::Variant;

use Win32::OLE::Const 'Microsoft Excel';



use File::Basename;

use File::Spec::Functions qw(:ALL);



use Spreadsheet::WriteExcel::Utility;

use Net::LDAP;



use HTML::TreeBuilder;

use HTML::FormatText;



use Mercury::OTA qw(connectToQC connectQC disconnectQC releaseConnections

    bugView filterText filterGrid);

use Mercury::Labels qw(dumpQCLabels assignBugLabels %bugLabel);

use CQC::Reporter qw(:ALL);



## Initialized Global Variables



# -*- subroutines -*-



sub rootCauseReport {

    my $tdc      = shift;

    my $fav      = shift;

    my $template = shift;

    my $rcReport = shift;



    my $color = colorScheme();

    my %tab = (

        defects         => 'defects',

        rcSummary       => 'Root Cause summary',

        invalidRC_chart => 'Invalid Root Cause chart',

        fullSummary     => 'Full RC summary',

        rcSTD           => 'RC by STD',

        subTeam         => 'Defects by Sub Team',

        scopeID         => 'Defects by Scope ID-CR#',

    );



    my @pivots

        = ($tab{fullSummary}, $tab{rcSTD}, $tab{subTeam}, $tab{scopeID},);

    

    $template = rel2abs($template);

    my $logger = get_logger();

    $logger->logdie("$template does not exist.") if (!-e $template);



    my $view = bugView($tdc, $fav)

        or $logger->logdie("Favorite $fav not found");

    my @columns = split ';', filterGrid($view);

    my %bugLabel = assignBugLabels($tdc);



    my (@fieldLabels, @fieldWidths, %columnIndex, $rcCategory,

        $rcPhase,     $rcReason,    $rcUUID,      $rcMgr,

        $rcSeverity,  $rcStatus

    );

    my $columnOffset = 0;

    foreach my $column (@columns) {

        my ($width, $name) = split ',', $column;

        push @fieldLabels, $bugLabel{$name};

        push @fieldWidths, $width;

        $columnIndex{$bugLabel{$name}} = $columnOffset;

        given ($bugLabel{$name}) {

            when ('Root Cause Category') {

                $rcCategory = $columnOffset;

            }

            when ('Root Cause Phase') {

                $rcPhase = $columnOffset;

            }

            when ('Root Cause Reason') {

                $rcReason = $columnOffset;

            }

            when ('User 4') {

                $rcMgr = $columnOffset;

            }

            when ('Assigned To UUID') {

                $rcUUID = $columnOffset;

            }

            when ('Severity') {

                $rcSeverity = $columnOffset;

            }

            when ('Status') {

                $rcStatus = $columnOffset;

            }

        }

        $columnOffset++;

    }

    my $rcValid = scalar @columns + 1;



    my $defects_ref = getDefects($tdc, $fav);



    #    store $defects_ref, 'rcStore';

    #    my $defects_ref = retrieve('rcStore');



    # set up the report output

    $logger->debug("creating spreadsheet...");

    my $excel = Win32::OLE->new('Excel.Application', 'Quit')

        or $logger->logdie("cannot start Excel: ", Win32::OLE->LastError());



    # avoid excessive Excel dialogs

    $excel->{DisplayAlerts} = 0;

    $excel->{Visible}       = 0;



    my $workbook = $excel->Workbooks->Open($template)

        or $logger->logdie("Can't open Excel workbook $template: ",

        Win32::OLE->LastError());



    # Task 'Process Defects'

    $logger->debug("processing each defect...");

    my %rootCause = getRootCauseMap($workbook);

    my (@invalidPhases, @invalidCategories, @invalidReasons, %totalDF, %team,

        $manager, $severity, $grandTotal);



    foreach my $defect (@{$defects_ref}) {



        # assign manager names for each defect

        if (not($manager = $defect->[$rcMgr])) {

            $manager = $defect->[$rcMgr] = getManager($defect->[$rcUUID]);

        }



        # cancelled defects are generally not included in the root cause

        # analysis, since there's no root cause for something that isn't

        # really a defect ;-), so just move on to the continue block

        next if ($defect->[$rcStatus] eq 'Cancelled');



        # validate the phase

        if (not(grep($_ eq $defect->[$rcPhase], @{$rootCause{Phase}}))) {

            $defect->[$rcValid] = 'Phase';

            push @invalidPhases, $defect;

            $team{$manager}{invalid}{total}++;

            $team{$manager}{invalid}{rcPhase}++;

        }

        else {



            # validate the category

            if (not(grep($_ eq $defect->[$rcCategory],

                        @{$rootCause{Categories}})

                )

                )

            {

                $defect->[$rcValid] = 'Category';

                push @invalidCategories, $defect;

                $team{$manager}{invalid}{total}++;

                $team{$manager}{invalid}{rcCategory}++;

                $totalDF{invalid}{$defect->[$rcCategory]}

                    {$defect->[$rcReason]}++;

            }

            else {



                # validate that reasons match categories

                if (not(grep ($_ eq $defect->[$rcReason],

                            @{  $rootCause{Category}{$defect->[$rcCategory]}

                                })

                    )

                    )

                {

                    $defect->[$rcValid] = 'Reason';

                    push @invalidReasons, $defect;

                    $team{$manager}{invalid}{total}++;

                    $team{$manager}{invalid}{rcReason}++;

                    $totalDF{invalid}{$defect->[$rcCategory]}

                        {$defect->[$rcReason]}++;

                }

                else {



                    # if we got all the way to here, the defect must have

                    # structurally valid root cause info

                    $team{$manager}{valid}++;

                    $totalDF{valid}{$defect->[$rcCategory]}

                        {$defect->[$rcReason]}++;

                }

            }

        }

    }

    continue {

        $team{$manager}{$defect->[$rcStatus]}++;

        $team{$manager}{totalDF}++;

        $totalDF{$defect->[$rcStatus]}++;

        $grandTotal++;

        if ($defect->[$rcStatus] ne 'Cancelled') {

            $team{$manager}{$defect->[$rcSeverity]}++;

            $totalDF{$defect->[$rcSeverity]}++;

        }

    }



    # Task 'defects'

    $logger->debug("starting task defects: populating spreadsheet...");

    my $sheet = $workbook->Worksheets($tab{defects})

        or $logger->logdie("Can't open Excel worksheet: ",

        Win32::OLE->LastError());



    #    store $defects_ref, 'rcStore';



    # write the defects if we have any

    if (scalar @{$defects_ref}) {



        # determine the lower-right corner of the range needed

        my $corner = xl_rowcol_to_cell(scalar(@{$defects_ref}),

            scalar(@{$defects_ref->[0]}) - 1);



        $sheet->Range("A2:$corner")->{Value} = $defects_ref;

    }



    # Task 'Root Cause summary'

    $logger->debug("starting task root cause summary...");

    $sheet = $workbook->Worksheets($tab{rcSummary})

        or $logger->logdie("Can't open Excel worksheet: ",

        Win32::OLE->LastError());



    # update the sheet date

    $sheet->Range('$C$1')->{Value} = xl_parse_date("Today");



    my %mgrCharts = (

        size    => 105,

        gutter  => 3,

        valid   => [],

        invalid => [],

    );



    foreach $manager (sort keys %team) {

        $team{$manager}{valid} += 0;

        foreach my $item qw(total rcPhase rcCategory rcReason) {

            $team{$manager}{invalid}{$item} += 0;

        }

        push @{$mgrCharts{valid}}, $manager if ($team{$manager}{valid});

        push @{$mgrCharts{invalid}}, $manager

            if ($team{$manager}{invalid}{total});

    }

    $logger->debug("valid: ", scalar @{$mgrCharts{valid}},

        " : ", join('/', @{$mgrCharts{valid}}));



# the invalid list includes managers with invalid phases but we don't currently

# chart those

    $logger->debug("invalid: ", scalar @{$mgrCharts{invalid}},

        " : ", join('/', @{$mgrCharts{invalid}}));



    # add some charts



    # find the rows of interest for the pie charts

    my @categoryRows;

    my $usedRows = $sheet->UsedRange->Find(

        {   What            => "*",

            LookIn          => xlValues,

            LookAt          => xlPart,

            SearchDirection => xlPrevious,

            SearchOrder     => xlByRows

        }

    )->{Row};

    foreach my $row (3 .. $usedRows - 1) {

        push @categoryRows, $row if $sheet->Cells($row, 2)->{Value};

    }



    # find the corner for our charts to start

    $logger->debug("invalid: ", scalar @{$mgrCharts{valid}});

    my $left       = $sheet->Range("A1:AI12")->Width;

    my $top        = $sheet->Range("A1:AI12")->Height;

    my $leftmargin = $left;



    my $row = 2;

    my $col = 15;

    foreach my $mgr (sort @{$mgrCharts{valid}}) {

        $sheet->Cells($row, $col++)->{Value} = $mgr;

    }

    $sheet->Cells($row, $col--)->{Value} = ' ';



    my $mgrChart = 0;

    foreach my $mgrCol (15 .. $col) {

        $logger->debug("total: ", $sheet->Cells($usedRows, $mgrCol)->{Value});

        next if ($sheet->Cells($usedRows, $mgrCol)->{Value} == 0);

        my $chart = $sheet->ChartObjects->Add(

            {   Left   => $left,

                Top    => $top,

                Width  => $mgrCharts{size},

                Height => $mgrCharts{size}

            }

        );

        my $source = $sheet->Cells($categoryRows[0], $mgrCol);

        foreach my $row (@categoryRows[1 .. $#categoryRows]) {

            $source = $excel->Union($source, $sheet->Cells($row, $mgrCol));

        }

        $chart->Chart->ChartWizard(

            {   Source    => $source,

                Gallery   => xlPie,

                Title     => $sheet->Cells(2, $mgrCol)->{Value},

                HasLegend => 0

            }

        );

        $chart->Chart->ChartTitle->Font->{Size} = 12;

        $chart->Chart->ApplyDataLabels(

            {   Type           => xlDataLabelsShowValue,

                HasLeaderLines => 0

            }

        );

        $chart->Chart->SeriesCollection(1)->DataLabels->{NumberFormat}

            = "0;-0;;@";

        $left += $mgrCharts{size} + $mgrCharts{gutter};



        if (not(++$mgrChart % 5)) {

            $top += $mgrCharts{size} + $mgrCharts{gutter};

            $left = $leftmargin;

        }

    }



    # Task 'Invalid Root Cause chart'

    $logger->debug("starting task invalid root cause chart...");

    $sheet = $workbook->Worksheets($tab{invalidRC_chart})

        or $logger->logdie("Can't open Excel worksheet: ",

        Win32::OLE->LastError());



    # populate only the categories and reasons that have data

    $row          = 3;

    @categoryRows = ();

    foreach my $category (sort keys %{$totalDF{invalid}}) {

        my $categoryRow = $row++;

        push @categoryRows, $categoryRow;

        my $col     = 2;

        my $reasons = scalar keys %{$totalDF{invalid}{$category}};

        $sheet->Cells($categoryRow, $col)->{Value} = $category;



        my $formula = '=SUM(R[1]C:R[' . $reasons . ']C)';

        $sheet->Cells($categoryRow, $col + 2)->{FormulaR1C1} = $formula;

        $sheet->Cells($categoryRow, $col + 4)->{FormulaR1C1} = $formula;

        $sheet->Cells($categoryRow, $col + 5)->{FormulaR1C1}

            = '=SUM(RC[-3], RC[-1])';



        $col += 6;

        foreach my $manager (keys %team) {

            $sheet->Cells($categoryRow, $col++)->{FormulaR1C1} = $formula;

        }

        $sheet->Range(xl_range($categoryRow, 2, $categoryRow, $col - 1))

            ->Interior->{Color} = $color->Gray;



        foreach my $reason (sort keys %{$totalDF{invalid}{$category}}) {

            my $reasonRow = $row++;

            my $col       = 3;

            $sheet->Cells($reasonRow, $col)->{Value} = $reason;

            $sheet->Cells($reasonRow, $col + 1)->{FormulaR1C1}

                = '=SUMPRODUCT((defectStatus<>"Cancelled")'

                . '*(Root_Cause_Phase=Phase_3)'

                . '*(Root_Cause_Category='

                . "R${categoryRow}C2)"

                . '*(Root_Cause_Reason=RC3))';

            $sheet->Cells($reasonRow, $col + 3)->{FormulaR1C1}

                = '=SUMPRODUCT((defectStatus<>"Cancelled")'

                . '*(Root_Cause_Phase=Phase_4)'

                . '*(Root_Cause_Category='

                . "R${categoryRow}C2)"

                . '*(Root_Cause_Reason=RC3))';

            $col += 5;

            my $formula

                = '=SUMPRODUCT((defectStatus<>"Cancelled")'

                . '*((Root_Cause_Phase=Phase_3)+(Root_Cause_Phase=Phase_4))'

                . '*(Root_Cause_Category='

                . "R${categoryRow}C2)"

                . '*(Root_Cause_Reason=RC3)*(STD=R2C))';

            foreach my $manager (keys %team) {

                $sheet->Cells($reasonRow, $col++)->{FormulaR1C1} = $formula;

            }

        }

    }



    # grand totals

    $col      = 2;

    $usedRows = $row;

    my $formula = '=';

    $sheet->Cells($row, $col)->{Value} = 'Grand Total';

    foreach my $row (@categoryRows[0 .. $#categoryRows]) {

        $formula .= "R${row}C+";

    }

    $formula =~ s/\+$//;

    $sheet->Cells($row, $col + 2)->{FormulaR1C1} = $formula;

    $sheet->Cells($row, $col + 4)->{FormulaR1C1} = $formula;

    $col += 6;

    foreach my $manager (keys %team) {

        $sheet->Cells($row, $col++)->{FormulaR1C1} = $formula;

    }

    my $range = $sheet->Range(xl_range($row, 2, $row, $col - 1));

    $range->Font->{Bold}      = 'True';

    $range->Font->{Italic}    = 'True';

    $range->Interior->{Color} = $color->LightBlue;



    # update chart series

    my $name = $sheet->{Name};

    my @x    = map {"'$name'!R" . $_ . "C2"} @categoryRows;

    my @y    = map {"'$name'!R" . $_ . "C7"} @categoryRows;



    # deal with some brain damage in what excel likes in series syntax

    # i.e., it gets really annoyed by superfluous parens and spaces

    my @series = (

        '=SERIES("Invalid Root Causes"',

        (scalar @x == 1) ? @x : '(' . join(',', @x) . ')',

        (scalar @y == 1) ? @y : '(' . join(',', @y) . ')',

        '1)'

    );

    $formula = join ',', @series;



    my $chart = $sheet->ChartObjects("Invalid Root Causes")->Chart;

    $chart->SeriesCollection(1)->{FormulaR1C1} = $formula;



    # find the corner for our charts to start

    $logger->debug("invalid: ", scalar @{$mgrCharts{invalid}});

    $left       = $sheet->Range("A1:AC12")->Width;

    $top        = $sheet->Range("A1:AC12")->Height;

    $leftmargin = $left;



    $row = 2;

    $col = 8;

    foreach my $mgr (sort @{$mgrCharts{invalid}}) {

        $sheet->Cells($row, $col++)->{Value} = $mgr;

    }

    $sheet->Cells($row, $col--)->{Value} = ' ';



    $mgrChart = 0;

    foreach my $mgrCol (8 .. $col) {

        my $col = xl_off_to_col($mgrCol);

        $logger->debug("total: ", $sheet->Cells($usedRows, $mgrCol)->{Value});

        next if ($sheet->Cells($usedRows, $mgrCol)->{Value} == 0);

        my $chart = $sheet->ChartObjects->Add(

            {   Left   => $left,

                Top    => $top,

                Width  => $mgrCharts{size},

                Height => $mgrCharts{size}

            }

        );

        my $source = $sheet->Cells($categoryRows[0], $mgrCol);

        foreach my $row (@categoryRows[1 .. $#categoryRows]) {

            $source = $excel->Union($source, $sheet->Cells($row, $mgrCol));

        }

        $chart->Chart->ChartWizard(

            {   Source    => $source,

                Gallery   => xlPie,

                Title     => $sheet->Cells(2, $mgrCol)->{Value},

                HasLegend => 0

            }

        );

        $chart->Chart->ChartTitle->Font->{Size} = 12;

        $chart->Chart->ApplyDataLabels(

            {   Type           => xlDataLabelsShowValue,

                HasLeaderLines => 0

            }

        );

        $chart->Chart->SeriesCollection(1)->DataLabels->{NumberFormat}

            = "0;-0;;@";

        $left += $mgrCharts{size} + $mgrCharts{gutter};



        if (not(++$mgrChart % 5)) {

            $top += $mgrCharts{size} + $mgrCharts{gutter};

            $left = $leftmargin;

        }

    }



    # refresh the pivot tables

    $workbook->RefreshAll;



    # TASK 'Invalid root causes'

    # add a worksheet for the invalid root causes

    $logger->debug("starting task invalid root causes...");

    $sheet = $workbook->Worksheets('Invalid root causes')

        or $logger->logdie("Can't open Excel worksheet: ",

        Win32::OLE->LastError());



    my %rcInvalid = (

        'Invalid Phases'     => \@invalidPhases,

        'Invalid Categories' => \@invalidCategories,

        'Invalid Reasons'    => \@invalidReasons,

    );



    # which columns are we interested in?

    $logger->debug("which columns are we interested in...");

    my $usedCols = $sheet->UsedRange->Find(

        {   What            => "*",

            LookIn          => xlValues,

            LookAt          => xlPart,

            SearchDirection => xlPrevious,

            SearchOrder     => xlByColumns

        }

    )->{Column};

    $row = 1;

    my @headers     = ();

    my %headerIndex = ();

    foreach my $column (1 .. $usedCols) {

        my $hdr

            = $sheet->Cells($row, $column)->{Value} eq 'STD'

            ? 'User 4'

            : $sheet->Cells($row, $column)->{Value};

        $headerIndex{$hdr} = $column;

        push @headers, $hdr;

    }

    if (exists $headerIndex{'User 4'}) {

        $headerIndex{STD} = $headerIndex{'User 4'};

    }

    $logger->debug("used columns $usedCols");



    my @rcHdrs

        = ('Root Cause Phase', 'Root Cause Category', 'Root Cause Reason');

    foreach

        my $field ('Invalid Phases', 'Invalid Categories', 'Invalid Reasons')

    {

        $row++;



        # scribble a header row

        $logger->debug("processing $field...");

        $sheet->Cells($row, 1)->{Value} = $field;

        foreach my $header (@rcHdrs) {

            $sheet->Cells($row, $headerIndex{$header})->{Value} = $header;

        }

        my $range = $sheet->Range(xl_range($row, 1, $row, $usedCols));

        $range->Font->{Bold}      = 'True';

        $range->Interior->{Color} = $color->MediumBlue;



        $logger->debug("write out the section values...");



        # save the section starting row and then pump out the section

        # !! it would be better if I wrote the whole block or at least

        #    a whole row at a time instead of a cell at a time

        my $sectionStart = $row;

        foreach my $invalidRC (@{$rcInvalid{$field}}) {

            $row++;

            my @cells = ();

            foreach my $header (@headers) {

                push @cells, $invalidRC->[$columnIndex{$header}];

            }

            $sheet->Range(xl_range($row, 1, $row, $usedCols))->{Value}

                = [@cells];

        }



        $logger->debug("sort the section...");



        # sort the section by STD, RC Phase, RC Category, RC Reason

        $sheet->Sort->SortFields->Clear;

        for my $sortCol (

            'STD',

            'Root Cause Phase',

            'Root Cause Category',

            'Root Cause Reason'

            )

        {

            $sheet->Sort->SortFields->Add(

                {   Key => $sheet->Range(

                        $sheet->Cells($sectionStart, $headerIndex{$sortCol}),

                        $sheet->Cells($row,          $headerIndex{$sortCol})

                    ),

                    Order      => xlAscending,

                    SortOn     => xlSortOnValues,

                    DataOption => xlSortNormal

                }

            );

        }

        $sheet->Sort->SetRange(

            $sheet->Range(

                $sheet->Cells($sectionStart, $headerIndex{'STD'}),

                $sheet->Cells($row, $headerIndex{'Root Cause Reason'})

            )

        );

        $sheet->Sort->{Header} = xlYes;

        $sheet->Sort->Apply;



        $logger->debug("create and outline group...");



        # create an outline group for the section

        $sheet->Range("$sectionStart:$row")->Group;



        # to make outlining prettier, scribble trailing (or summary) row

        $row++;

        $sheet->Cells($row, 1)->{Value} = $field;

        foreach my $header (@rcHdrs) {

            $sheet->Cells($row, $headerIndex{$header})->{Value} = $header;

        }

        $range = $sheet->Range($sheet->Cells($row, 1),

            $sheet->Cells($row, $usedCols));

        $range->Font->{Bold}                       = 'True';

        $range->Borders(xlEdgeBottom)->{LineStyle} = xlContinuous;

        $range->Interior->{Color}                  = $color->LightBlue;

    }



    # collapse the outline to the first level

    $sheet->Outline->ShowLevels({RowLevels => 1});



    #    # expand a group in the outline (leaving this code in as an example)

    #    $sheet->Rows(3)->{ShowDetail} = 1;



    # Task 'Overview'

    # open worksheet for the Overview

    $logger->debug("starting task Overview...");

    $sheet = $workbook->Worksheets('Overview')

        or $logger->logdie("Can't open Excel worksheet: ",

        Win32::OLE->LastError());



    my @ovStatus = ('STD', 'Sev 1', 'Sev 2', 'Sev 3', 'Cancelled', 'Total');

    my @ovValidity = qw(Valid Invalid %Valid);

    my @ovRootcause     = qw(Phase Category Reason);

    my @overviewHeaders = (@ovStatus, @ovValidity, @ovRootcause);

    my $lWidth          = scalar @ovStatus;

    my $cWidth          = scalar @ovValidity;

    my $rWidth          = scalar @ovRootcause;

    my $tWidth          = scalar @overviewHeaders;

    my $tRow            = $row = 2;

    my $lCol            = 2;

    my $rCol            = $lCol + $tWidth - 1;

    $col = $lCol;



    $range = $sheet->Range(xl_range($row, $lCol, $row, $rCol));

    $range->{HorizontalAlignment} = xlHAlignLeft;

    $range->Font->{Bold}          = 'True';

    $range->Font->{Color}         = $color->White;

    $range->Interior->{Color}     = $color->DarkBlue;

    $sheet->Range(

        xl_range($row, $lCol + $lWidth, $row, $lCol + $lWidth + $cWidth - 1))

        ->Interior->{Color} = $color->DarkGreen;

    $sheet->Range(xl_range($row, $lCol + $lWidth + $cWidth, $row, $rCol))

        ->Interior->{Color} = $color->DarkBrown;

    $sheet->Cells($row, $lCol)->{Value} = 'Defects by STD and Severity';

    $sheet->Cells($row, $lCol + $lWidth)->{Value} = 'Root Cause Validity';

    $sheet->Cells($row, $lCol + $lWidth + $cWidth)->{Value} = 'Invalid Area';



    $row++;



    $range = $sheet->Range(xl_range($row, $lCol, $row, $rCol));

    $range->Font->{Bold}      = 'True';

    $range->Interior->{Color} = $color->MediumBlue;

    foreach my $header (@overviewHeaders) {

        $sheet->Cells($row, $col++)->{Value} = $header;

    }

    $row++;



    foreach my $teamName (sort keys %team) {

        if ($team{$teamName}{totalDF}) {

            my $col = $lCol;

            $sheet->Range(

                xl_range($row, $lCol, $row, $lCol + $lWidth + $cWidth - 2))

                ->Interior->{Color} = $color->LightBlue

                if ($row % 2);

            $sheet->Cells($row, $col)->{Value} = $teamName;

            $sheet->Cells($row, ++$col)->{Value}

                = $team{$teamName}{'Severity 1'};

            $sheet->Cells($row, ++$col)->{Value}

                = $team{$teamName}{'Severity 2'};

            $sheet->Cells($row, ++$col)->{Value}

                = $team{$teamName}{'Severity 3'};

            $sheet->Cells($row, ++$col)->{Value}

                = $team{$teamName}{'Cancelled'};

            $sheet->Cells($row, ++$col)->{Value} = $team{$teamName}{totalDF};



            $sheet->Cells($row, ++$col)->{Value} = $team{$teamName}{valid};

            $sheet->Cells($row, ++$col)->{Value}

                = $team{$teamName}{invalid}{total};

            $sheet->Cells($row, ++$col)->{FormulaR1C1}

                = '=IFERROR(RC[-2]/(RC[-2]+RC[-1]), "N/A")';



            $sheet->Range(

                xl_range($row, $lCol + $lWidth + $cWidth, $row, $rCol))

                ->Interior->{Color} = $color->LightBrown

                if ($row % 2);

            $sheet->Cells($row, ++$col)->{Value}

                = $team{$teamName}{invalid}{rcPhase};

            $sheet->Cells($row, ++$col)->{Value}

                = $team{$teamName}{invalid}{rcCategory};

            $sheet->Cells($row, ++$col)->{Value}

                = $team{$teamName}{invalid}{rcReason};



            $row++;

        }

    }



    $range = $sheet->Range(xl_range($row, $lCol, $row, $rCol));

    $range->Font->{Bold}                       = 'True';

    $range->Font->{Italic}                     = 'True';

    $range->Interior->{Color}                  = $color->MediumBlue;

    $range->Borders(xlEdgeTop)->{LineStyle}    = xlContinuous;

    $range->Borders(xlEdgeBottom)->{LineStyle} = xlContinuous;



    $col = $lCol;

    $sheet->Cells($row, $col)->{Value} = 'Grand Total';

    $sheet->Cells($row, ++$col)->{Value} = $totalDF{'Severity 1'};

    $sheet->Cells($row, ++$col)->{Value} = $totalDF{'Severity 2'};

    $sheet->Cells($row, ++$col)->{Value} = $totalDF{'Severity 3'};

    $sheet->Cells($row, ++$col)->{Value} = $totalDF{'Cancelled'};

    $sheet->Cells($row, ++$col)->{Value} = $grandTotal;



    $sheet->Range(

        xl_range($tRow + 1, $lCol + $lWidth - 1, $row, $lCol + $lWidth - 1))

        ->Borders(xlEdgeRight)->{LineStyle} = xlContinuous;

    $sheet->Range(

        xl_range(

            $tRow + 1,

            $lCol + $lWidth + $cWidth - 1,

            $row,

            $lCol + $lWidth + $cWidth - 1

        )

    )->Borders(xlEdgeRight)->{LineStyle} = xlContinuous;



    for (1 .. $cWidth + $rWidth) {

        my $formula = '=SUM(R[' . ($tRow + 2 - $row) . ']C:R[-1]C)';

        $sheet->Cells($row, ++$col)->{FormulaR1C1} = $formula;

    }

    $sheet->Cells($row, $lCol + $lWidth + $cWidth - 1)->{FormulaR1C1}

        = '=RC[-2]/(RC[-2]+RC[-1])';



    $sheet->Range(xl_range($tRow, $lCol, $row, $rCol))->Font->{Name}

        = 'Calibri';

    $sheet->Range(xl_range($tRow, $lCol, $row, $rCol))->Font->{Size} = 11;



    # use conditional format for %valid

    $range = $sheet->Range(

        xl_range(

            $tRow + 2,

            $lCol + $lWidth + $cWidth - 1,

            $row - 1,

            $lCol + $lWidth + $cWidth - 1

        )

    );

    $range->FormatConditions->AddDatabar;

    $range->FormatConditions($range->FormatConditions->{Count})->{ShowValue}

        = 1;

    $range->FormatConditions($range->FormatConditions->{Count})

        ->SetFirstPriority;

    $range->FormatConditions(1)

        ->MinPoint->Modify({newtype => xlConditionValueLowestValue});

    $range->FormatConditions(1)

        ->MaxPoint->Modify({newtype => xlConditionValueHighestValue});

    $range->FormatConditions(1)->BarColor->{Color}        = 13012579;

    $range->FormatConditions(1)->BarColor->{TintAndShade} = 0;



    # Task 'Features'

    # open worksheet for the Feature mapping

    $logger->debug("starting task Features...");

    $sheet = $workbook->Worksheets('Feature mapping')

        or $logger->logdie("Can't open Excel worksheet: ",

        Win32::OLE->LastError());



    $usedRows = $sheet->UsedRange->Find(

        {   What            => "*",

            LookIn          => xlValues,

            LookAt          => xlPart,

            SearchDirection => xlPrevious,

            SearchOrder     => xlByRows

        }

    )->{Row};

    $usedCols = $sheet->UsedRange->Find(

        {   What            => "*",

            LookIn          => xlValues,

            LookAt          => xlPart,

            SearchDirection => xlPrevious,

            SearchOrder     => xlByColumns

        }

    )->{Column};



    # build the list mapping features to scope items

    my $feature_ref

        = $sheet->Range(xl_range(2, 1, $usedRows, $usedCols))->{Value};



    my %feature;

    foreach my $row (@{$feature_ref}) {

        if (@$row[0]) {

            $name = @$row[0];

            push @{$feature{names}}, $name;

            next;

        }

        else {

            foreach my $item (@{$row}) {

                if ($item) {

                    push @{$feature{name}{$name}{scopes}}, $item;

                }

            }

        }

    }



    # get the scope counts from the scope pivot

    my $scopeSheet = $workbook->Worksheets('Defects by Scope ID-CR#')

        or $logger->logdie("Can't open Excel worksheet: ",

        Win32::OLE->LastError());



    $usedRows = $scopeSheet->UsedRange->Find(

        {   What            => "*",

            LookIn          => xlValues,

            LookAt          => xlPart,

            SearchDirection => xlPrevious,

            SearchOrder     => xlByRows

        }

    )->{Row};



    my $scope_ref

        = $scopeSheet->Range(xl_range(4, 1, $usedRows - 1, 2))->{Value};

    my %scopeID = map {$_->[0] => $_->[1]} @{$scope_ref};



    # process each scope item and assign to a feature



    foreach my $fn (@{$feature{names}}) {

        my $pattern = join '|', @{$feature{name}{$fn}{scopes}};

        $feature{name}{$fn}{pattern} = qr/$pattern/i;

    }



    my %featureSummary;

    foreach my $scope (keys %scopeID) {

        my $matched = 0;

        foreach my $fn (@{$feature{names}}) {

            if ($scope =~ /$feature{name}{$fn}{pattern}/) {

                $featureSummary{$fn}{$scope} = $scopeID{$scope};

                $matched = 1, last;

            }

        }

        if (not $matched) {

            $featureSummary{Others}{$scope} = $scopeID{$scope};

        }

    }



    # update the "Defect by Feature" sheet

    $logger->debug("starting task Defect by Feature...");

    $sheet = $workbook->Worksheets('Defects by Feature')

        or $logger->logdie("Can't open Excel worksheet: ",

        Win32::OLE->LastError());



    my @featureRows;

    $row = 1;

    foreach my $fn (@{$feature{names}}, 'Others') {

        next if (not exists $featureSummary{$fn});

        my $featureRow = ++$row;

        push @featureRows, $featureRow;

        if ($fn eq 'Others') {

            $sheet->Cells($featureRow, 1)->{Value}

                = 'Others (non-feature, CR, deferred, blank, etc.)';

        }

        else {

            $sheet->Cells($featureRow, 1)->{Value} = $fn;

        }

        $range = $sheet->Range(xl_range($featureRow, 1, $featureRow, 4));

        $range->Font->{Bold}      = 'True';

        $range->Interior->{Color} = $color->Gray;



        foreach my $scope (sort keys %{$featureSummary{$fn}}) {

            $sheet->Cells(++$row, 2)->{Value} = $scope;

            $sheet->Cells($row,   3)->{Value} = $featureSummary{$fn}{$scope};

        }



        $sheet->Cells($featureRow, 4)->{FormulaR1C1}

            = '=SUM(R[+1]C[-1]:R[+' . ($row - $featureRow) . ']C[-1])';

    }

    $sheet->Cells(++$row, 1)->{Value}       = 'Grand Total';

    $sheet->Cells($row,   4)->{FormulaR1C1} = '=SUM(R2C:R[-1]C';



    $range = $sheet->Range(xl_range($row, 1, $row, 4));

    $range->Font->{Bold}      = 'True';

    $range->Font->{Italic}    = 'True';

    $range->Interior->{Color} = $color->LightBlue;



    # update chart series

    $name = $sheet->{Name};



    @x = map {"'$name'!R" . $_ . "C1"} @categoryRows;

    @y = map {"'$name'!R" . $_ . "C4"} @categoryRows;



    # deal with some brain damage in what excel likes in series syntax

    # i.e., it gets really annoyed by superfluous parens and spaces

    @series = (

        '=SERIES("Defects by Feature"',

        (scalar @x == 1) ? @x : '(' . join(',', @x) . ')',

        (scalar @y == 1) ? @y : '(' . join(',', @y) . ')',

        '1)'

    );

    $formula = join ',', @series;



    $chart = $sheet->ChartObjects(1)->Chart;

    $chart->SeriesCollection(1)->{FormulaR1C1} = $formula;



    $logger->debug("finish up and save a snapshot...");



    # save a snapshot for today

    my $snapShot = saveSnapshot($workbook, $rcReport, 'Root Cause summary');



    # be nice and close the patient

    $workbook->Close();

    $excel->Quit();



    #    $Data::Dumper::Terse = 1;

    #    $logger->debug(Dumper(%team, %mgrCharts, %totalDF));



    return (\%team, \%totalDF, \%mgrCharts, $grandTotal);

}





sub getRootCauseMap {

    my $workbook = shift;



    my $wbName = 'Reason mapping';

    my $logger = get_logger();



    # open worksheet for the root cause mapping

    my $sheet = $workbook->Worksheets($wbName)

        or $logger->logdie("Can't open Excel worksheet: $wbName",

        Win32::OLE->LastError());



    my $usedRows = $sheet->UsedRange->Find(

        {   What            => "*",

            LookIn          => xlValues,

            LookAt          => xlPart,

            SearchDirection => xlPrevious,

            SearchOrder     => xlByRows

        }

    )->{Row};



    # build the list mapping categories to reason items

    my $rc_ref = $sheet->Range(xl_range(2, 1, $usedRows, 2))->{Value};



    my %rootCause = (

        Phase => [

            'Phase 3: Design, Development and Pre-Production Testing',

            'Phase 4: Install and Production Readiness Test',

        ],

    );



    my @group;

    my $newGroup = 1;

    foreach my $row (@{$rc_ref}) {

        my ($category, $reason) = @{$row};

        if ($category) {

            if ($newGroup) {

                $newGroup = 0;

                @group    = ();

            }

            push @{$rootCause{Categories}}, $category;

            push @group, $category;

        }

        else {

            push @{$rootCause{Reasons}}, $reason;

            foreach my $cat (@group) {

                push @{$rootCause{Category}{$cat}}, $reason;

            }

            $newGroup = 1;

        }

    }

    return %rootCause;

}





sub rtmByReqReport {

    my $tdc         = shift;

    my $filters_ref = shift;

    my $report      = shift;



    my $logger = get_logger();



    my %testCoverage;

    foreach my $filter (@$filters_ref) {

        my $reqFactory = $tdc->ReqFactory;

        my $reqFilter  = $reqFactory->Filter;



        my @pathElements = split /\\/, $filter;

        my $parent = $reqFactory->Item(0);



        foreach my $element (@pathElements) {

            my @reqList

                = in $reqFactory->Find($parent->ID, 'RQ_REQ_NAME', $element,

                16);

            (my $reqID = $reqList[0]) =~ s/,.*//;

            $parent = $reqFactory->Item($reqID);

        }

        next if (not defined $parent);



        my @requirements;

        @requirements = getReqChildren($reqFactory, $parent, \@requirements);



        foreach my $requirement (@requirements) {

            my @tests = in $requirement->GetCoverlist;

            foreach my $test (@tests) {



                # I don't understand why this is, but some tests don't have a

                # Subject field defined, so I have to ignore those.

                # TODO: Is there any way to get the QC folder path for those?

                if (not defined $test->Field('TS_SUBJECT')) {

                    $logger->error('undefined subject with requirement ',

                        $requirement->Name, ' and test ', $test->Name);

                }

                else {

                    my $path = $test->Field('TS_SUBJECT')->Path . "\\"

                        . $test->Name;

                    $testCoverage{$path}->{Folder}

                        = $test->Field('TS_SUBJECT')->Path;

                    $testCoverage{$path}->{Name} = $test->Name;

                    $testCoverage{$path}->{Description}

                        = $test->Field('TS_DESCRIPTION');

                    push @{$testCoverage{$path}->{Requirements}},

                        $requirement->Field('RQ_USER_05');

                }

            }

        }

        $logger->debug("Filtered requirements found: ", scalar @requirements);

    }



    my @coverage;

    foreach my $test (keys %testCoverage) {

        push @coverage,

            [

            $testCoverage{$test}->{Folder},

            $testCoverage{$test}->{Name},

            $testCoverage{$test}->{Description},

            join("\n", @{$testCoverage{$test}->{Requirements}})

            ];

    }



    rtmReport(\@coverage, $report);



    return scalar(@coverage);

}





sub rtmByTestLabReport {

    my $tdc         = shift;

    my $filters_ref = shift;

    my $report      = shift;

    my $rpt_del_req = shift;

    my $cqc         = shift;

    my $project     = shift;



    my $logger = get_logger();

    

    my @testSets;

    foreach my $folder (@{$project->{folders}->{folder}}) {

        push @testSets, getFolderTestSets($tdc, $folder);

    }

    $logger->info('Total test sets found: ', scalar @testSets);

    

    my $progress = 0;

    my $totalTC  = 0;

    my $totalTS  = scalar(@testSets);

    

    my %tcField = mapTCFields($cqc);

    

    my (@covered, @notcovered);

    foreach my $ts (@testSets) {

        #

        # Get all the test instances in the project node

        #

        $progress++;

        my $tsFactory       = $ts->TSTestFactory;

        my @testInstances   = in $tsFactory->NewList('');

        my $tsCount         = scalar(@testInstances);

        my $tsArea          = $ts->TestSetFolder->Name;

        my $tsSubArea       = $ts->Name;

        my $tcInstance      = 0;



        $logger->debug("($progress/$totalTS) test instances in: ",

            $tsArea, "\\", $tsSubArea, " : ", $tsCount);

        $totalTC += $tsCount;



        if ($tsCount) {

            # Look at each test instance and collect its details

            foreach my $tc (@testInstances) {

                my $tn = $tc->Name;

                if ($tc->Test->HasCoverage) {

                    push @covered, $tc;

                }

                else {

                    push @notcovered, $tc;

                }

            }

        }

    }

    $logger->debug("covered: ",      scalar(@covered),

                   " not covered: ", scalar(@notcovered));



    my @coverage;



    my $tc = 0;

    foreach my $test (@covered) {

        my @coverList = in $test->Test->GetCoverList;

        my @requirements;

        foreach my $requirement (@coverList) {

            if (not $requirement->Field('RQ_USER_03')) {

                $logger->warn(

                    'Unknown status in requirement ',

                    $requirement->Name,

                    ' for test ',

                    $test->Test->Field('TS_SUBJECT')->Path,

                    '\\',

                    $test->Test->Name

                );

            }



            # we don't want to include any requirements that have been

            # deleted so we need to check that status first

            if (   ($requirement->Field('RQ_USER_03'))

                && ($requirement->Field('RQ_USER_03') eq 'Deleted'))

            {

                $logger->warn(

                    'Deleted requirement ',

                    $requirement->Name,

                    ' for test ',

                    $test->Test->Field('TS_SUBJECT')->Path,

                    '\\',

                    $test->Test->Name

                );

            }

            else {



               # we don't want the ReqPRO tag in the requirement name

               # so we use the Requirement Name field in RQ_USER_05 but

               # sometimes we see an anomaly in the requirements where

               # the field will be blank, so we fallback to the Name field

               # in those cases.

                if ($requirement->Field('RQ_USER_05')) {

                    push @requirements, $requirement->Field('RQ_USER_05');

                }

                else {

                    # QC requirements are now (7/11/11) being populated in 

                    # such a way that this is almost always true. So for now

                    # I'm commenting out this warning message

#                    $logger->warn(

#                        'Null requirement name field for ',

#                        $test->Test->Field('TS_SUBJECT')->Path,

#                        '\\', $test->Test->Name,

#                        ', ReqPro tag name: ', $requirement->Field('RQ_USER_06'),

#                        ', RQ_REQ_NAME: ', $requirement->Field('RQ_REQ_NAME'),

#                        ', using: ', $requirement->Name

#                    );

                    push @requirements, $requirement->Name;

                }

            }

        }



        # we should get here with a requirements list but I suppose it's

        # possible that we could end up with an empty list if all the

        # requirements for this test case have been deleted, so we need

        # to check for an empty list

        if (@requirements) {

            push @coverage,

                [

                $test->Test->Field('TS_SUBJECT')->Path,

                $test->Test->Name,

                getDescription($test, 'Lab'),

                join("\n", @requirements),

                ];

        }

        else {

            $logger->warn(

                'Empty requirement set for test ',

                $test->Test->Field('TS_SUBJECT')->Path,

                '\\', $test->Test->Name

            );

        }

        unless (++$tc % 100) {

            $logger->debug("__ processing test case $tc");

        }

    }

    $logger->debug("Filtered tests found: ", scalar @coverage);



    rtmReport(\@coverage, $report);



    return scalar(@coverage);

}





sub rtmByTestReport {

    my $tdc         = shift;

    my $filters_ref = shift;

    my $report      = shift;

    my $rpt_del_req = shift;



    my $logger = get_logger();



    my @coverage;

    foreach my $filter (@$filters_ref) {



        # filter from the current folder using a cross-filter to

        # select only those tests which have an associated requirement



        my $tsFactory = $tdc->TestFactory;

        my $tsFilter  = $tsFactory->Filter;



        my $rqFactory = $tdc->ReqFactory;

        my $rqFilter  = $rqFactory->Filter;



        $tsFilter->SetProperty('Filter', 'TS_SUBJECT', $filter);

        $rqFilter->SetProperty('Filter', 'RQ_REQ_ID',  '> 0');

        $tsFilter->SetXFilter('TEST-REQ', "TRUE", $rqFilter->Text);



        my @tsList = in $tsFilter->NewList();

        $logger->debug("Total tests found: ", scalar(@tsList));



        my $tc = 0;

        foreach my $test (@tsList) {

            my @coverList = in $test->GetCoverList;

            my @requirements;

            foreach my $requirement (@coverList) {

                if (not $requirement->Field('RQ_USER_03')) {

                    $logger->warn(

                        'Unknown status in requirement ',

                        $requirement->Name,

                        ' for test ',

                        $test->Field('TS_SUBJECT')->Path,

                        '\\',

                        $test->Name

                    );

                }



                # we don't want to include any requirements that have been

                # deleted so we need to check that status first

                if (   ($requirement->Field('RQ_USER_03'))

                    && ($requirement->Field('RQ_USER_03') eq 'Deleted'))

                {

                    $logger->warn(

                        'Deleted requirement ',

                        $requirement->Name,

                        ' for test ',

                        $test->Field('TS_SUBJECT')->Path,

                        '\\',

                        $test->Name

                    );

                }

                else {



                   # we don't want the ReqPRO tag in the requirement name

                   # so we use the Requirement Name field in RQ_USER_05 but

                   # sometimes we see an anomaly in the requirements where

                   # the field will be blank, so we fallback to the Name field

                   # in those cases.

                    if ($requirement->Field('RQ_USER_05')) {

                        push @requirements, $requirement->Field('RQ_USER_05');

                    }

                    else {

                        $logger->warn(

                            'Null requirement name field for ',

                            $test->Field('TS_SUBJECT')->Path,

                            '\\', $test->Name

                        );

                        push @requirements, $requirement->Name;

                    }

                }

            }



            # we should get here with a requirements list but I suppose it's

            # possible that we could end up with an empty list if all the

            # requirements for this test case have been deleted, so we need

            # to check for an empty list

            if (@requirements) {

                push @coverage,

                    [

                    $test->Field('TS_SUBJECT')->Path,

                    $test->Name,

                    getDescription($test, 'Plan'),

                    join("\n", @requirements),

                    ];

            }

            else {

                $logger->warn(

                    'Empty requirement set for test ',

                    $test->Field('TS_SUBJECT')->Path,

                    '\\', $test->Name

                );

            }

            unless (++$tc % 100) {

                $logger->debug("__ processing test case $tc");

            }

        }

    }

    $logger->debug("Filtered tests found: ", scalar @coverage);



    rtmReport(\@coverage, $report);



    return scalar(@coverage);

}





sub rtmReport {

    my $coverage = shift;

    my $report   = shift;



    my $logger = get_logger();



    # set up the report output

    $logger->debug("creating spreadsheet...");

    my $excel = Win32::OLE->new('Excel.Application', 'Quit')

        or $logger->logdie("cannot start Excel: ", Win32::OLE->LastError());



    # avoid excessive Excel dialogs

    $excel->{DisplayAlerts} = 0;

    $excel->{Visible}       = 0;



    my $workbook = $excel->Workbooks->Add

        or $logger->logdie("Can't create Excel workbook",

        Win32::OLE->LastError());



    my $sheet = $workbook->Worksheets("Sheet1");



    # write the covered requirements if we have any

    if (scalar @$coverage) {

        $logger->debug("Writing ", scalar(@$coverage), " tests to report");

        my $columns = scalar @{$coverage->[0]};

        my $rows    = scalar @$coverage;

        my $row     = 1;

        $sheet->Rows($row)->Font->{Bold}    = 'True';

        $sheet->Range('A:A')->{ColumnWidth} = 75;

        $sheet->Range('B:B')->{ColumnWidth} = 30;

        $sheet->Range('C:C')->{ColumnWidth} = 100;

        $sheet->Range('D:D')->{ColumnWidth} = 40;

        $sheet->Range($sheet->Cells($row, 1), $sheet->Cells($row, $columns))

            ->{Value} = ['TC Path', 'Name', 'Description', 'Requirement'];



       # FIXME - why do I have to write this row by row? 

       # I don't know the underlying cause but when I pass it the entire

       # array it stops after 258 rows. If I write row by row it usually 

       # succeeds and doesn't take an inordinate amount of time. But even

       # writing row by row doesn't always work... sometimes it fails to

       # write one or more of the cells. What's strange is that it's not

       # a fatal error and there isn't an apparent reason for the failure.

       # The record that fails is larger than the others but not huge and

       # certainly within excel's limits.

        foreach my $tc (@$coverage) {

#            say Devel::Size::total_size($tc);

            $row++;

            my $col = 1;

            foreach my $cellvalue (@$tc) {

                $sheet->Cells($row, $col++)->{Value} = $cellvalue;

                if (Win32::OLE->LastError()) {

                    $logger->warn(Win32::OLE->LastError(),

                    " at row $row, col ", $col-1);

                }

            }

            unless ($row % 100) {

                $logger->debug("__ processing test case $row");

            }

        }

        saveSnapshot($workbook, $report, 'Sheet1');

    }

    else {

        $logger->warn(

            "No covered requirements found; no spreadsheet created.");

    }

    $workbook->Close();

    $excel->Quit();

}





# -*- stubs -*-



1;    # Magic true value required at end of module





__END__