view release on metacpan or  search on metacpan

lib/CPANPLUS/Internals/Report.pm  view on Meta::CPAN

        ### the bit where we inform what went wrong
        $message .= REPORT_MESSAGE_FAIL_HEADER->( $stage, $capture );

        ### add a list of what modules have been loaded of your prereqs list
        $message .= REPORT_LOADED_PREREQS->($mod);

        ### add a list of versions of toolchain modules
        $message .= REPORT_TOOLCHAIN_VERSIONS->($mod);

        ### the footer
        $message .= REPORT_MESSAGE_FOOTER->();

    } elsif ( $grade eq GRADE_PASS and ( $status and defined $status->{capture} ) ) {
        ### the bit where we inform what went right
        $message .= REPORT_MESSAGE_PASS_HEADER->( $stage, $status->{capture} );

        ### add a list of what modules have been loaded of your prereqs list
        $message .= REPORT_LOADED_PREREQS->($mod);

        ### add a list of versions of toolchain modules
        $message .= REPORT_TOOLCHAIN_VERSIONS->($mod);

        ### the footer
        $message .= REPORT_MESSAGE_FOOTER->();

    }

    msg( loc("Sending test report for '%1'", $dist), $verbose);

    ### reporter object ###
    my $reporter = do {
        my $args = $conf->get_conf('cpantest_reporter_args') || {};

        unless( UNIVERSAL::isa( $args, 'HASH' ) ) {
            error(loc("'%1' must be a hashref, ignoring...",
                      'cpantest_reporter_args'));
            $args = {};
        }

        Test::Reporter->new(
            grade           => $grade,
            distribution    => $dist,
            distfile        => $distfile,
            via             => "CPANPLUS $int_ver",
            timeout         => $conf->get_conf('timeout') || 60,
            debug           => $conf->get_conf('debug'),
            %$args,
        );
    };

    ### set a custom mx, if requested
    $reporter->mx( [ $conf->get_conf('cpantest_mx') ] )
        if $conf->get_conf('cpantest_mx');

    ### set the from address ###
    $reporter->from( $conf->get_conf('email') )
        if $conf->get_conf('email') !~ /\@example\.\w+$/i;

    ### give the user a chance to programmatically alter the message
    $message = $self->_callbacks->munge_test_report->($mod, $message, $grade);

    ### add the body if we have any ###
    $reporter->comments( $message ) if defined $message && length $message;

    ### do a callback to ask if we should send the report
    unless ($self->_callbacks->send_test_report->($mod, $grade)) {
        msg(loc("Ok, not sending test report"));
        return 1;
    }

    ### do a callback to ask if we should edit the report
    if ($self->_callbacks->edit_test_report->($mod, $grade)) {
        ### test::reporter 1.20 and lower don't have a way to set
        ### the preferred editor with a method call, but it does
        ### respect your env variable, so let's set that.
        local $ENV{VISUAL} = $conf->get_program('editor')
                                if $conf->get_program('editor');

        $reporter->edit_comments;
    }

    ### allow to be overridden, but default to the normal address ###
    $reporter->address( $address );

    ### should we save it locally? ###
    if( $save ) {
        if( my $file = $reporter->write() ) {
            msg(loc("Successfully wrote report for '%1' to '%2'",
                    $dist, $file), $verbose);
            return $file;

        } else {
            error(loc("Failed to write report for '%1'", $dist));
            return;
        }

    ### XXX should we do an 'already sent' check? ###
    ### something broke :( ###
    }
    else {
        my $status;
        eval {
            $status = $reporter->send();
        };
        if ( $@ ) {
           error(loc("Could not send '%1' report for '%2': %3",
                $grade, $dist, $@));
           return;
        }
        if ( $status ) {
           msg(loc("Successfully sent '%1' report for '%2'", $grade, $dist),
              $verbose);
           return 1;
        }
        error(loc("Could not send '%1' report for '%2': %3",
                $grade, $dist, $reporter->errstr));
        return;
    }
}

sub _verify_missing_prereqs {
    my $self = shift;
    my %hash = @_;

    ### check arguments ###
    my ($mod, $missing);
    my $tmpl = {
            module  => { required => 1, store => \$mod },
            missing => { required => 1, store => \$missing },
    };

    check( $tmpl, \%hash ) or return;