view release on metacpan or  search on metacpan

lib/CPAN/Testers/ParseReport.pm  view on Meta::CPAN

        PASSFAIL: for my $pf ("pass","fail") {
                my $minx = $Opt{"min".$pf} or next PASSFAIL;
                my $x = $dumpvars{"meta:ok"}{uc $pf}{uc $pf};
                if ($x < $minx) {
                    # bump samplesize, remove already sampled reports from array, redo
                    my $bump = int($samplesize * 0.05)+1;
                    $samplesize += $bump;
                    for my $k (sort {$b <=> $a} keys %taken) {
                        splice @$reports, $k, 1;
                    }
                    redo REPEATER;
                }
            }
        }
    }
    if ($Opt{dumpvars}) {
        my $dumpfile = $Opt{dumpfile} || "ctgetreports.out";
        open my $fh, ">", $dumpfile or die "Could not open '$dumpfile' for writing: $!";
        print $fh _yaml_dump(\%dumpvars);
        close $fh or die "Could not close '$dumpfile': $!"
    }
    if ($Opt{solve}) {
        solve(\%dumpvars,%Opt);
    }
}

=head2 $bool = _looks_like_qp($raw_report)

We had to acknowledge the fact that some MTAs swallow the MIME-Version
header while passing MIME through. So we introduce fallback heuristics
that try to determine if a report is written in quoted printable.

Note that this subroutine is internal, just documented to have the
internals documented.

The current implementation counts the number of QP escaped spaces and
equal signs.

=cut

sub _looks_like_qp {
    my($report) = @_;
    my $count_space = () = $report =~ /=20/g;
    return 1 if $count_space > 12;
    my $count_equal = () = $report =~ /=3D/g;
    return 1 if $count_equal > 12;
    return 1 if $count_space+$count_equal > 24;
    return 0; # waiting for a counter example
}

=head2 $extract = parse_report($target,$dumpvars,%Opt)

Reads one report. $target is the local filename to read (but see below
for option 'article'). $dumpvars is a hashref which gets filled with
descriptive stats about PASS/FAIL/etc. %Opt are the options as
described in the C<ctgetreports> manpage. $extract is a hashref
containing the found variables.

Note: this parsing is a bit dirty but as it seems good enough I'm not
inclined to change it. We parse HTML with regexps only, not an HTML
parser. Only the entities are decoded.

In %Opt you can use

    article => $some_full_article_as_scalar

to use this function to parse one full article as text. When this is
given, the argument $target is not read, but its basename is taken to
be the id of the article. (OMG, hackers!)

=cut
sub parse_report {
    my($target,$dumpvars,%Opt) = @_;
    our @q;
    my $id = basename($target);
    # warn "DEBUG: id[$id]";
    my($ok,$about);

    my(%extract);

    my($report,$isHTML) = _get_cooked_report($target, \%Opt);
    my @qr = map /^qr:(.+)/, @{$Opt{q}};
    if ($Opt{raw} || @qr) {
        for my $qr (@qr) {
            my $cqr = eval "qr{$qr}";
            die "Could not compile regular expression '$qr': $@" if $@;
            my(@matches) = $report =~ $cqr;
            my $v;
            if (@matches) {
                if (@matches==1) {
                    $v = $matches[0];
                } else {
                    $v = join "", map {"($_)"} @matches;
                }
            } else {
                $v = "";
            }
            $extract{"qr:$qr"} = $v;
        }
    }

    my $report_writer;
    my $moduleunpack = {};
    my $expect_prereq = 0;
    my $expect_toolchain = 0;
    my $expecting_toolchain_soon = 0;
    my $expect_module_versions_report = 0;
    my $expect_characteristics_libperl = 0;
    my $fallback_p5 = "";

    my $in_summary = 0;
    my $in_summary_seen_platform = 0;
    my $in_prg_output = 0;
    my $in_env_context = 0;
    my $in_test_summary = 0;
    my $in_characteristics = 0;

    my $current_headline;
    my @previous_line = ""; # so we can neutralize line breaks
    my @rlines = split /\r?\n/, $report;
 LINE: for (@rlines) {