view release on metacpan or  search on metacpan

lib/Test/Smoke/Reporter.pm  view on Meta::CPAN

=item B<Other values> are taken as the filename for the smokeresults

=back

=cut

sub _read {
    my $self = shift;
    my( $nameorref ) = @_;
    $nameorref = '' unless defined $nameorref;

    my $vmsg = "";
    local *SMOKERSLT;
    if ( ref $nameorref eq 'SCALAR' ) {
        $self->{_outfile} = $$nameorref;
        $vmsg = "from internal content";
    } elsif ( ref $nameorref eq 'ARRAY' ) {
        $self->{_outfile} = join "", @$nameorref;
        $vmsg = "from internal content";
    } elsif ( ref $nameorref eq 'GLOB' ) {
        *SMOKERSLT = *$nameorref;
        $self->{_outfile} = do { local $/; <SMOKERSLT> };
        $vmsg = "from anonymous filehandle";
    } else {
        if ( $nameorref ) {
            $vmsg = "from $nameorref";
            $self->{_outfile} = read_logfile($nameorref, $self->{v});
            defined($self->{_outfile}) or do {
                require Carp;
                Carp::carp( "Cannot read smokeresults ($nameorref): $!" );
                $vmsg = "did fail";
            };
        } else { # Allow intentional default_buildcfg()
            $self->{_outfile} = undef;
            $vmsg = "did fail";
        }
    }
    $self->log_info("Reading smokeresult %s", $vmsg);
}

=head2 $self->_parse( )

Interpret the contents of the outfile and prepare them for processing,
so report can be made.

=cut

sub _parse {
    my $self = shift;

    $self->{_rpt}    = \my %rpt;
    $self->{_cache}  = {};
    $self->{_mani}   = [];
    $self->{configs} = \my @new;
    return $self unless defined $self->{_outfile};

    my ($cfgarg, $debug, $tstenv, $start, $statarg, $fcnt);
    $rpt{count} = 0;
    # reverse and use pop() instead of using unshift()
    my @lines           = reverse split m/\n+/, $self->{_outfile};
    my $previous        = "";
    my $previous_failed = "";

    while (defined (local $_ = pop @lines)) {
        m/^\s*$/ and next;
        m/^-+$/  and next;
        s/\s*$//;

        if (my ($status, $time) = /(Started|Stopped) smoke at (\d+)/) {
            if ($status eq "Started") {
                $start = $time;
                $rpt{started} ||= $time;
            }
            elsif (defined $start) {
                my $elapsed = $time - $start;
                $rpt{secs} += $elapsed;
                @new and $new[-1]{duration} = $elapsed;
            }
            next;
        }

        if (my ($patch) = m/^   \s*
                                Smoking\ patch\s*
                                ((?:[0-9a-f]+\s+\S+)|(?:\d+\S*))
                                /x )
        {
            my ($pl, $descr) = split ' ', $patch;
            $rpt{patchlevel} = $patch;
            $rpt{patch}      = $pl || $patch;
            $rpt{patchdescr} = $descr || $pl;
            next;
        }
        if (/^Smoking branch (\S+)/) {
            $rpt{smokebranch} = $1;
        }

        if (/^MANIFEST /) {
            push @{$self->{_mani}}, $_;
            next;
        }

        if (s/^\s*Configuration:\s*//) {

            # You might need to do something here with
            # the previous Configuration: $cfgarg
            $rpt{statcfg}{$statarg} = $fcnt if defined $statarg;
            $fcnt = 0;

            $rpt{count}++;
            s/-Dusedevel(\s+|$)//;
            s/\s*-des//;
            $statarg = $_;
            $debug = s/-D(DEBUGGING|usevmsdebug)\s*// ? "D" : "N";
            $debug eq 'D' and $rpt{dbughow} = "-D$1";
            s/\s+$//;

            $cfgarg = $_ || "";

            push(
                @new,
                {
                    arguments => $_,
                    debugging => $debug,
                    started   => __posixdate($start),
                    results   => [],
                }
            );
            push @{$rpt{cfglist}}, $_ unless $rpt{config}->{$cfgarg}++;
            $tstenv          = "";
            $previous_failed = "";
            next;
        }

        if (my ($cinfo) = /^Compiler info: (.+)$/) {
            $rpt{$cfgarg}->{cinfo} = $cinfo;
            $rpt{cinfo} ||= $cinfo;
            @{$new[-1]}{qw( cc ccversion )} = split m/ version / => $cinfo, 2;
            next;
        }

        if (m/(?:PERLIO|TSTENV)\s*=\s*([-\w:.]+)/
              # skip this if it's from a build failure, since the
              # Unable to build... pushed an M
              && (!@{$new[-1]{results}}
                  || $new[-1]{results}[0]{summary} ne "M")) {
            $tstenv          = $1;
            $previous_failed = "";
            $rpt{$cfgarg}->{summary}{$debug}{$tstenv} ||= "?";
            my ($io_env, $locale) = split m/:/ => $tstenv,
                2;
            push(
                @{$new[-1]{results}},
                {
                    io_env        => $io_env,
                    locale        => $locale,
                    summary       => "?",
                    statistics    => undef,
                    stat_tests    => undef,
                    stat_cpu_time => undef,
                    failures      => [],
                }
            );

            # Deal with harness output
            s/^(?:PERLIO|TSTENV)\s*=\s+[-\w:.]+(?: :crlf)?\s*//;
        }

        if (m/\b(Files=[0-9]+,\s*Tests=([0-9]+),.*?=\s*([0-9.]+)\s*CPU)/) {
            $new[-1]{results}[-1]{statistics}    = $1;
            $new[-1]{results}[-1]{stat_tests}    = $2;
            $new[-1]{results}[-1]{stat_cpu_time} = $3;
        }
        elsif (
            m/\b(u=([0-9.]+)\s+
                    s=([0-9.]+)\s+
                    cu=([0-9.]+)\s+
                    cs=([0-9.]+)\s+
                    scripts=[0-9]+\s+
                    tests=([0-9]+))/xi
            )
        {
            $new[-1]{results}[-1]{statistics}    = $1;
            $new[-1]{results}[-1]{stat_tests}    = $6;
            $new[-1]{results}[-1]{stat_cpu_time} = $2 + $3 + $4 + $5;
        }

        if (m/^\s*All tests successful/) {
            $rpt{$cfgarg}->{summary}{$debug}{$tstenv} = "O";
            $new[-1]{results}[-1]{summary} = "O";
            next;
        }

        if (m/Inconsistent test ?results/) {
            ref $rpt{$cfgarg}->{$debug}{$tstenv}{failed}
                or $rpt{$cfgarg}->{$debug}{$tstenv}{failed} = [];

            if (not $rpt{$cfgarg}->{summary}{$debug}{$tstenv}
                or $rpt{$cfgarg}->{summary}{$debug}{$tstenv} ne "F")
            {
                $rpt{$cfgarg}->{summary}{$debug}{$tstenv} = "X";
                $new[-1]{results}[-1]{summary} = "X";
            }
            push @{$rpt{$cfgarg}->{$debug}{$tstenv}{failed}}, $_;
            while (m/^ \s* (\S+?) \s* \.+(?:\s+\.+)* \s* (\w.*?) \s*$/xgm) {
                my ($_test, $_info) = ($1, $2);

                push(
                    @{$new[-1]{results}[-1]{failures}},
                    $_info =~ m/^ \w+ $/x

lib/Test/Smoke/Reporter.pm  view on Meta::CPAN

Return the contents of C<< $self->{outfile} >> either by reading the file or
returning the cached version.

=cut

sub get_outfile {
    my $self = shift;
    return $self->{_outfile} if $self->{_outfile};

    my $fq_outfile = catfile($self->{ddir}, $self->{outfile});
    return $self->{_outfile} = read_logfile($fq_outfile, $self->{v});
}

=head2 $reporter->write_to_file( [$name] )

Write the C<< $self->report >> to file. If name is omitted it will
use C<< catfile( $self->{ddir}, $self->{rptfile} ) >>.

=cut

sub write_to_file {
    my $self = shift;
    return unless defined $self->{_outfile};
    my( $name ) = shift || ( catfile $self->{ddir}, $self->{rptfile} );

    $self->log_info("Writing report to '%s'", $name);
    local *RPT;
    open RPT, "> $name" or do {
        require Carp;
        Carp::carp( "Error creating '$name': $!" );
        return;
    };
    print RPT $self->report;
    close RPT or do {
        require Carp;
        Carp::carp( "Error writing to '$name': $!" );
        return;
    };
    $self->log_info("'%s' written OK", $name);
    return 1;
}

=head2 $reporter->smokedb_data()

Transport the report to the gateway. The transported data will also be stored
locally in the file mktest.jsn

=cut

sub smokedb_data {
    my $self = shift;
    $self->log_info("Gathering CoreSmokeDB information...");

    my %rpt  = map { $_ => $self->{$_} } keys %$self;
    $rpt{manifest_msgs}   = delete $rpt{_mani};
    $rpt{applied_patches} = [$self->registered_patches];
    $rpt{sysinfo}         = do {
        my %Conf = get_smoked_Config($self->{ddir} => qw( version lfile ));
        my $si = System::Info->new;
        my ($osname, $osversion) = split m/ - / => $si->os, 2;
        (my $ncpu      = $si->ncpu          || "?") =~ s/^\s*(\d+)\s*/$1/;
        (my $user_note = $self->{user_note} || "")  =~ s/(\S)[\s\r\n]*\z/$1\n/;
        {
            architecture     => lc $si->cpu_type,
            config_count     => $self->{_rpt}{count},
            cpu_count        => $ncpu,
            cpu_description  => $si->cpu,
            duration         => $self->{_rpt}{secs},
            git_describe     => $self->{_rpt}{patchdescr},
            git_id           => $self->{_rpt}{patch},
            smoke_branch     => $self->{_rpt}{smokebranch},
            hostname         => $self->{hostname} || $si->host,
            lang             => $ENV{LANG},
            lc_all           => $ENV{LC_ALL},
            osname           => $osname,
            osversion        => $osversion,
            perl_id          => $Conf{version},
            reporter         => $self->{from},
            reporter_version => $VERSION,
            smoke_date       => __posixdate($self->{_rpt}{started}),
            smoke_revision   => $Test::Smoke::VERSION,
            smoker_version   => $Test::Smoke::Smoker::VERSION,
            smoke_version    => $Test::Smoke::VERSION,
            test_jobs        => $ENV{TEST_JOBS},
            username         => $ENV{LOGNAME} || getlogin || getpwuid($<) || "?",
            user_note        => $user_note,
            smoke_perl       => ($^V ? sprintf("%vd", $^V) : $]),
        };
    };
    $rpt{compiler_msgs} = [$self->ccmessages];
    $rpt{nonfatal_msgs} = [$self->nonfatalmessages];
    $rpt{skipped_tests} = [$self->user_skipped_tests];
    $rpt{harness_only}  = delete $rpt{harnessonly};
    $rpt{summary}       = $self->summary;

    $rpt{log_file} = undef;
    my $rpt_fail = $rpt{summary} eq "PASS" ? 0 : 1;
    if (my $send_log = $self->{send_log}) {
        if (   ($send_log eq "always")
            or ($send_log eq "on_fail" && $rpt_fail))
        {
            $rpt{log_file} = $self->get_logfile();
        }
    }
    $rpt{out_file} = undef;
    if (my $send_out = $self->{send_out}) {
        if (   ($send_out eq "always")
            or ($send_out eq "on_fail" && $rpt_fail))
        {
            $rpt{out_file} = $self->get_outfile();
        }
    }
    delete $rpt{$_} for qw/from send_log send_out user_note/, grep m/^_/ => keys %rpt;

    my $json = JSON->new->utf8(1)->pretty(1)->encode(\%rpt);

    # write the json to file:
    my $jsn_file = catfile($self->{ddir}, $self->{jsnfile});
    if (open my $jsn, ">", $jsn_file) {
        binmode($jsn);