CPAN-Testers-Schema
10 results

 view release on metacpan or  search on metacpan

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

}

#pod =method ordered_schema_versions
#pod
#pod Get the available schema versions by reading the files in the share
#pod directory. These versions can then be upgraded to using the
#pod L<cpantesters-schema> script.
#pod
#pod =cut

sub ordered_schema_versions( $self ) {
    my @versions =
        uniq sort
        map { /[\d.]+-([\d.]+)/ }
        grep { /CPAN-Testers-Schema-[\d.]+-[\d.]+-MySQL[.]sql/ }
        path( dist_dir( 'CPAN-Testers-Schema' ) )->children;
    return '0.000', @versions;
}

#pod =method populate_from_api
#pod

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

#pod =item * release
#pod
#pod =item * summary
#pod
#pod =item * report
#pod
#pod =back
#pod
#pod =cut

sub populate_from_api( $self, $search, @tables ) {
    my $ua = $self->{_ua} ||= Mojo::UserAgent->new;
    $ua->inactivity_timeout( 120 );
    my $base_url = $self->{_url} ||= 'http://api.cpantesters.org/v3';
    my $dtf = DateTime::Format::ISO8601->new();

    # Establish dependencies
    my @order = qw( upload summary release report );
    my $match_tables = join '|', @order;
    if ( my @unknown = grep { !/^(?:$match_tables)$/ } @tables ) {
        die 'Unknown table(s): ', join ', ', @unknown;

lib/CPAN/Testers/Schema/Result/PerlVersion.pm  view on Meta::CPAN 

    default_value => 0,
};

#pod =method new
#pod
#pod The constructor will automatically fill in any missing information based
#pod on the supplied C<version> field.
#pod
#pod =cut

sub new( $class, $attrs ) {
    if ( !$attrs->{perl} ) {
        ( $attrs->{perl} ) = $attrs->{version} =~ m{^v?(\d+\.\d+\.\d+)};
    }
    if ( !$attrs->{patch} ) {
        $attrs->{patch} = ( $attrs->{version} =~ m{patch} ) ? 1 : 0;
    }
    if ( !$attrs->{devel} ) {
        my ( $version ) = $attrs->{version} =~ m{^v?\d+\.(\d+)};
        $attrs->{devel} =
            (

lib/CPAN/Testers/Schema/Result/Stats.pm  view on Meta::CPAN 


might_have perl_version => 'CPAN::Testers::Schema::Result::PerlVersion' =>
    { 'foreign.version' => 'self.perl' };

#pod =method dist_name
#pod
#pod The name of the distribution that was tested.
#pod
#pod =cut

sub dist_name( $self ) {
    return $self->dist;
}

#pod =method dist_version
#pod
#pod The version of the distribution that was tested.
#pod
#pod =cut

sub dist_version( $self ) {
    return $self->version;
}

#pod =method lang_version
#pod
#pod The language and version the test was executed with
#pod
#pod =cut

sub lang_version( $self ) {
    return sprintf '%s v%s', 'Perl 5', $self->perl;
}

#pod =method platform
#pod
#pod The platform the test was run on
#pod
#pod =cut

sub platform( $self ) {
    return $self->get_inflated_column( 'platform' );
}

#pod =method grade
#pod
#pod The report grade. One of 'pass', 'fail', 'na', 'unknown'.
#pod
#pod =cut

sub grade( $self ) {
    return $self->state;
}

#pod =method tester_name
#pod
#pod The name of the tester who sent the report
#pod
#pod =cut

sub tester_name( $self ) {
    # The name could either be in quotes before the e-mail, or in
    # parentheses after.
    for my $re ( qr{"([^"]+)"}, qr{\(([^)]+)\)} ) {
        if ( $self->tester =~ $re ) {
            # And it may have high-byte characters HTML-escaped
            return html_unescape $1;
        }
    }
    # Can't find just the name, so send it all for now...
    return html_unescape $self->tester;
}

#pod =method datetime
#pod
#pod Get a L<DateTime> object for the date/time this report was generated.
#pod
#pod =cut

sub datetime( $self ) {
  my ( $y, $m, $d, $h, $n, $s ) = $self->fulldate =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})?$/;
  return DateTime->new(
    year => $y,
    month => $m,
    day => $d,
    hour => $h,
    minute => $n,
    second => $s // 0,
  );
}

lib/CPAN/Testers/Schema/Result/TestReport.pm  view on Meta::CPAN 

#pod
#pod This is overridden to provide sane defaults for the C<id> and C<created>
#pod fields.
#pod
#pod B<NOTE:> You should not supply a C<created> unless you are creating
#pod reports in the past. Reports created in the past will be hidden from
#pod many feeds, and may cause failures to not be reported to authors.
#pod
#pod =cut

sub new( $class, $attrs ) {
    $attrs->{report}{id} = $attrs->{id} ||= Data::UUID->new->create_str;
    $attrs->{created} ||= DateTime->now( time_zone => 'UTC' );
    $attrs->{report}{created} ||= $attrs->{created}->datetime . 'Z';
    return $class->next::method( $attrs );
};

#pod =method upload
#pod
#pod     my $upload = $row->upload;
#pod
#pod Get the associated L<CPAN::Testers::Schema::Result::Upload> object for
#pod the distribution tested by this test report.
#pod
#pod =cut

sub upload( $self ) {
    my ( $dist, $vers ) = $self->report->{distribution}->@{qw( name version )};
    return $self->result_source->schema->resultset( 'Upload' )
        ->search({ dist => $dist, version => $vers })->single;
}

#pod =method dist_name
#pod
#pod The name of the distribution that was tested.
#pod
#pod =cut

sub dist_name( $self ) {
    return $self->report->{distribution}{name};
}

#pod =method dist_version
#pod
#pod The version of the distribution that was tested.
#pod
#pod =cut

sub dist_version( $self ) {
    return $self->report->{distribution}{version};
}

#pod =method lang_version
#pod
#pod The language and version the test was executed with
#pod
#pod =cut

sub lang_version( $self ) {
    return sprintf '%s v%s',
        $self->report->{environment}{language}->@{qw( name version )};
}

#pod =method platform
#pod
#pod The platform the test was run on
#pod
#pod =cut

sub platform( $self ) {
    return join ' ', $self->report->{environment}{language}{archname};
}

#pod =method grade
#pod
#pod The report grade. One of 'pass', 'fail', 'na', 'unknown'.
#pod
#pod =cut

sub grade( $self ) {
    return $self->report->{result}{grade};
}

#pod =method text
#pod
#pod The full text of the report, either from the phased sections or the
#pod "uncategorized" section.
#pod
#pod =cut

my @output_phases = qw( configure build test install );
sub text( $self ) {
    return $self->report->{result}{output}{uncategorized}
        || join "\n\n", grep defined, $self->report->{result}{output}->@{ @output_phases };
}

#pod =method tester_name
#pod
#pod The name of the tester who sent the report
#pod
#pod =cut

sub tester_name( $self ) {
    return html_unescape $self->report->{reporter}{name};
}

1;

__END__

=pod

=head1 NAME

lib/CPAN/Testers/Schema/ResultSet/PerlVersion.pm  view on Meta::CPAN 

use CPAN::Testers::Schema::Base 'ResultSet';
use Log::Any '$LOG';
use Carp ();

#pod =method maturity
#pod
#pod Filter Perl versions of the given maturity. One of C<stable> or C<dev>.
#pod
#pod =cut

sub maturity( $self, $maturity ) {
    if ( $maturity eq 'stable' ) {
        return $self->search({ devel => 0 });
    }
    elsif ( $maturity eq 'dev' ) {
        return $self->search({ devel => 1 });
    }
    Carp::croak "Unknown maturity: $maturity. Must be one of: 'stable', 'dev'";
}

lib/CPAN/Testers/Schema/ResultSet/Release.pm  view on Meta::CPAN 

#pod =method by_dist
#pod
#pod     $rs = $rs->by_dist( 'My-Dist' );
#pod     $rs = $rs->by_dist( 'My-Dist', '0.001' );
#pod
#pod Add a dist constraint to the query (with optional version), replacing
#pod any previous dist constraints.
#pod
#pod =cut

sub by_dist( $self, $dist, $version = undef ) {
    my %search = ( 'me.dist' => $dist );
    if ( $version ) {
        $search{ 'me.version' } = $version;
    }
    return $self->search( \%search );
}

#pod =method by_author
#pod
#pod     $rs = $rs->by_author( 'PREACTION' );
#pod
#pod Add an author constraint to the query, replacing any previous author
#pod constraints.
#pod
#pod =cut

sub by_author( $self, $author ) {
    return $self->search( { 'upload.author' => $author }, { join => 'upload' } );
}

#pod =method since
#pod
#pod     $rs = $rs->since( '2016-01-01T00:00:00' );
#pod
#pod Restrict results to only those that have been updated since the given
#pod ISO8601 date.
#pod
#pod =cut

sub since( $self, $date ) {
    my $fulldate = $date =~ s/[-:T]//gr;
    $fulldate = substr $fulldate, 0, 12; # 12 digits makes YYYYMMDDHHNN
    return $self->search( { 'report.fulldate' => { '>=', $fulldate } }, { join => 'report' } );
}

#pod =method maturity
#pod
#pod     $rs = $rs->maturity( 'stable' );
#pod
#pod Restrict results to only those dists that are stable. Also supported:
#pod 'dev' to restrict to only development dists.
#pod
#pod =cut

sub maturity( $self, $maturity ) {
    my %map = ( 'stable' => 1, 'dev' => 2 );
    $maturity = $map{ $maturity };
    return $self->search( { 'me.distmat' => $maturity } );
}

#pod =method total_by_release
#pod
#pod     $rs = $rs->total_by_release
#pod
#pod Sum the pass/fail/na/unknown counts by release distribution and version.
#pod
#pod =cut

sub total_by_release( $self ) {
    my @total_cols = qw( pass fail na unknown );
    my $me = $self->current_source_alias;
    return $self->search( {}, {
        # The uploadid here is included to allow joins from the results
        group_by => [ map "$me.$_", qw( dist version uploadid ) ],
        select => [
            qw( dist version uploadid ),
            ( map { \"SUM($_) AS $_" } @total_cols ),
            ( \sprintf 'SUM(%s) AS total', join ' + ', @total_cols )
        ],

lib/CPAN/Testers/Schema/ResultSet/Stats.pm  view on Meta::CPAN 

use Carp ();

#pod =method since
#pod
#pod     my $rs = $rs->since( $iso_dt );
#pod
#pod Restrict the resultset to reports submitted since the given date/time (in ISO8601 format).
#pod
#pod =cut

sub since( $self, $date ) {
    my $fulldate = $date =~ s/[-:T]//gr;
    $fulldate = substr $fulldate, 0, 12; # 12 digits makes YYYYMMDDHHNN
    return $self->search( { fulldate => { '>=', $fulldate } } );
}

#pod =method perl_maturity
#pod
#pod     $rs = $rs->perl_maturity( 'stable' ) # or 'dev'
#pod
#pod Restrict the resultset to reports submitted for either C<stable> or
#pod C<dev> Perl versions.
#pod
#pod =cut

sub perl_maturity( $self, $maturity ) {
    my $devel = $maturity eq 'stable' ? 0 : $maturity eq 'dev' ? 1
        : Carp::croak "Unknown maturity: $maturity; Must be one of: 'stable', 'dev'";
    if ( !$devel ) {
        # Patch versions are not stable either
        return $self->search(
            { 'perl_version.devel' => 0, 'perl_version.patch' => 0 },
            { join => 'perl_version' },
        );
    }
    return $self->search(

lib/CPAN/Testers/Schema/ResultSet/TestReport.pm  view on Meta::CPAN 

#pod     my $rs = $rs->dist( 'Perl 5', 'CPAN-Testers-Schema', '0.012' );
#pod
#pod Fetch reports only for the given distribution, optionally for the given
#pod version. Returns a new C<CPAN::Testers::Schema::ResultSet::TestReport>
#pod object that will only return reports with the given data.
#pod
#pod This can be used to scan the full reports for specific data.
#pod
#pod =cut

sub dist( $self, $lang, $dist, $version=undef ) {
    return $self->search( {
        'report' => [ -and =>
            \[ "->> '\$.environment.language.name'=?", $lang ],
            \[ "->> '\$.distribution.name'=?", $dist ],
            ( defined $version ? (
                \[ "->> '\$.distribution.version'=?", $version ],
            ) : () ),
        ],
    } );
}

lib/CPAN/Testers/Schema/ResultSet/TestReport.pm  view on Meta::CPAN 

#pod =method insert_metabase_fact
#pod
#pod     my $row = $rs->insert_metabase_fact( $fact );
#pod
#pod Convert a L<Metabase::Fact> object to the new test report structure and
#pod insert it into the database. This is for creating backwards-compatible
#pod APIs.
#pod
#pod =cut

sub insert_metabase_fact( $self, $fact ) {
    $LOG->infof( 'Inserting test report from Metabase fact (%s)', $fact->core_metadata->{guid} );
    my ( $fact_report ) = grep { blessed $_ eq 'CPAN::Testers::Fact::LegacyReport' } $fact->content->@*;
    my %fact_data = (
        $fact_report->content->%*,
        $fact->core_metadata->%{qw( creation_time guid )},
        $fact->core_metadata->{resource}->metadata->%{qw( dist_name dist_version dist_file cpan_id )},
    );

    my $user_id = $fact->core_metadata->{creator}->resource;
    my ( $metabase_user ) = $self->result_source->schema->resultset( 'MetabaseUser' )

lib/CPAN/Testers/Schema/ResultSet/Upload.pm  view on Meta::CPAN 


#pod =method by_dist
#pod
#pod     $rs = $rs->by_dist( 'My-Dist' );
#pod
#pod Add a dist constraint to the query, replacing any previous dist
#pod constraints.
#pod
#pod =cut

sub by_dist( $self, $dist ) {
    return $self->search( { 'me.dist' => $dist } );
}

#pod =method by_author
#pod
#pod     $rs = $rs->by_author( 'PREACTION' );
#pod
#pod Add an author constraint to the query, replacing any previous author
#pod constraints.
#pod
#pod =cut

sub by_author( $self, $author ) {
    return $self->search( { 'me.author' => $author } );
}

#pod =method since
#pod
#pod     $rs = $rs->since( '2016-01-01T00:00:00' );
#pod
#pod Restrict results to only those that have been updated since the given
#pod ISO8601 date.
#pod
#pod =cut

sub since( $self, $date ) {
    my $dt = DateTime::Format::ISO8601->parse_datetime( $date );
    return $self->search( { released => { '>=' => $dt->epoch } } );
}

#pod =method recent
#pod
#pod     # 20 most recent
#pod     $rs = $rs->recent( 20 );
#pod
#pod     # Just the most recent
#pod     $rs = $rs->recent( 1 );
#pod
#pod Return the most-recently released distributions sorted by their release
#pod date/time, descending. Defaults to returning up to 20 results.
#pod
#pod =cut

sub recent( $self, $count = 20 ) {
    return $self->search( { }, {
        order_by => { -desc => 'released' },
        rows => $count,
        page => 1,
    } );
}

#pod =method latest_by_dist
#pod
#pod Return the dist/version pair for the latest version of all dists
#pod selected by the current resultset.
#pod
#pod =cut

sub latest_by_dist( $self ) {
    return $self->search( {}, {
        select => [
            qw( dist ),
            \'MAX(me.version) AS version',
        ],
        as => [ qw( dist version ) ],
        group_by => [ map "me.$_", qw( dist ) ],
        having => \'version = MAX(version)',
    } );
}

t/resultset/test_report.t  view on Meta::CPAN 

#       creator => 'metabase:user:XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX',
#   );
#
# Create a new metabase report to submit. Returns a data structure
# suitable to be encoded into JSON and submitted.
#
# This code is stolen from:
#   * Test::Reporter::Transport::Metabase sub send
#   * Metabase::Client::Simple sub submit_fact

sub create_metabase_report( %attrs ) {
    my $user = delete $attrs{creator};
    my $text = delete $attrs{textreport};
    my $report = Test::Reporter->new( transport => 'Null', %attrs );

    # Build CPAN::Testers::Report with its various component facts.
    my $metabase_report = CPAN::Testers::Report->open(
        resource => 'cpan:///distfile/' . $report->distfile,
        creator => $user,
    );

t/resultset/test_report.t  view on Meta::CPAN 

#       grade => 'pass',
#       distribution => 'Foo-Bar',
#       version => '1.24',
#       language => 'Perl 5',
#   );
#
# Create a JSON report suitable to be stored in the database. Most of
# the data is set to sane defaults, leaving only the testable data to
# change.

sub create_json_report( %args ) {
    my $report = {
        reporter => {
            name => 'Doug Bell',
            email => 'doug@preaction.me',
        },
        environment => {
            system => {
                osname => 'linux',
                osversion => '2.14.4',
            },



( run in 0.679 second using v1.01-cache-2.11-cpan-65fba6d93b7 )