From 8c53bbfc34a2eebc9a416ff8c7bdaa91a0fddced Mon Sep 17 00:00:00 2001 From: Doug Bell Date: Sun, 22 Apr 2018 13:10:27 +0200 Subject: [PATCH] add classes for perl version metadata tables These classes allow access to the `perl_version` table, which stores metadata about released Perl versions. Fixes #13 --- lib/CPAN/Testers/Schema/Result/PerlVersion.pm | 126 ++++++++++++++++++ .../Testers/Schema/ResultSet/PerlVersion.pm | 46 +++++++ .../CPAN-Testers-Schema-0.022-0.023-MySQL.sql | 17 ++- ...CPAN-Testers-Schema-0.022-0.023-SQLite.sql | 13 +- share/CPAN-Testers-Schema-0.023-MySQL.sql | 15 ++- share/CPAN-Testers-Schema-0.023-SQLite.sql | 15 ++- t/result/perl_version.t | 58 ++++++++ t/resultset/perl_version.t | 36 +++++ 8 files changed, 322 insertions(+), 4 deletions(-) create mode 100644 lib/CPAN/Testers/Schema/Result/PerlVersion.pm create mode 100644 lib/CPAN/Testers/Schema/ResultSet/PerlVersion.pm create mode 100644 t/result/perl_version.t create mode 100644 t/resultset/perl_version.t diff --git a/lib/CPAN/Testers/Schema/Result/PerlVersion.pm b/lib/CPAN/Testers/Schema/Result/PerlVersion.pm new file mode 100644 index 0000000..f87e9f9 --- /dev/null +++ b/lib/CPAN/Testers/Schema/Result/PerlVersion.pm @@ -0,0 +1,126 @@ +use utf8; +package CPAN::Testers::Schema::Result::PerlVersion; +our $VERSION = '0.023'; +# ABSTRACT: Metadata about Perl versions + +=head1 SYNOPSIS + + my $perl = $schema->resultset( 'PerlVersion' )->find( '5.26.0' ); + say "Stable" unless $perl->devel; + + $schema->resultset( 'PerlVersion' )->find_or_create({ + version => '5.30.0', # Version reported by Perl + perl => '5.30.0', # Parsed Perl version string + patch => 0, # Has patches applied + devel => 0, # Is development version (odd minor version) + }); + + # Fill in metadata automatically + $schema->resultset( 'PerlVersion' )->find_or_create({ + version => '5.31.0 patch 1231', + # devel will be set to 1 + # patch will be set to 1 + # perl will be set to 5.31.0 + }); + +=head1 DESCRIPTION + +This table holds metadata about known Perl versions. Through this table we can +quickly list which Perl versions are stable/development. + +=head1 SEE ALSO + +L, L + +=cut + +use CPAN::Testers::Schema::Base 'Result'; + +table 'perl_version'; + +=attr version + +The Perl version reported by the tester. This is the primary key. + +=cut + +primary_column version => { + data_type => 'varchar', + size => 255, + is_nullable => 0, +}; + +=attr perl + +The parsed version of Perl in C format. + +If not specified when creating a new row, the Perl version will be parsed +and this field updated accordingly. + +=cut + +column perl => { + data_type => 'varchar', + size => 32, + is_nullable => 1, +}; + +=attr patch + +If true (C<1>), this Perl has patches applied. Defaults to false (C<0>). + +If not specified when creating a new row, the Perl version will be parsed +and this field updated accordingly. + +=cut + +column patch => { + data_type => 'tinyint', + size => 1, + default_value => 0, +}; + +=attr devel + +If true (C<1>), this Perl is a development Perl version. Development Perl +versions have an odd C field (the second number) like C<5.27.0>, +C<5.29.0>, C<5.31.0>, etc... Release candidates (like C<5.28.0 RC0>) are +also considered development versions. + +If not specified when creating a new row, the Perl version will be parsed +and this field updated accordingly. + +=cut + +column devel => { + data_type => 'tinyint', + size => 1, + default_value => 0, +}; + +=method new + +The constructor will automatically fill in any missing information based +on the supplied C field. + +=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} = + ( + ( $version >= 7 && $version % 2 ) || + $attrs->{version} =~ m{^v?\d+\.\d+\.\d+ RC\d+} + ) ? 1 : 0; + } + return $class->next::method( $attrs ); +} + +1; diff --git a/lib/CPAN/Testers/Schema/ResultSet/PerlVersion.pm b/lib/CPAN/Testers/Schema/ResultSet/PerlVersion.pm new file mode 100644 index 0000000..3410c5b --- /dev/null +++ b/lib/CPAN/Testers/Schema/ResultSet/PerlVersion.pm @@ -0,0 +1,46 @@ +use utf8; +package CPAN::Testers::Schema::ResultSet::PerlVersion; +our $VERSION = '0.023'; +# ABSTRACT: Query Perl version metadata + +=head1 SYNOPSIS + + my $rs = $schema->resultset( 'PerlVersion' ); + $rs->find_or_create({ version => '5.27.0' }); + + $rs = $rs->maturity( 'stable' ); # or 'dev' + +=head1 DESCRIPTION + +This object helps to query Perl version metadata. + +=head1 SEE ALSO + +L, L, +L + +=cut + +use CPAN::Testers::Schema::Base 'ResultSet'; +use Log::Any '$LOG'; +use Carp (); + +=method maturity + +Filter Perl versions of the given maturity. One of C or C. + +=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'"; +} + + +1; + diff --git a/share/CPAN-Testers-Schema-0.022-0.023-MySQL.sql b/share/CPAN-Testers-Schema-0.022-0.023-MySQL.sql index af5809c..92af8ff 100644 --- a/share/CPAN-Testers-Schema-0.022-0.023-MySQL.sql +++ b/share/CPAN-Testers-Schema-0.022-0.023-MySQL.sql @@ -1,4 +1,19 @@ -- Convert schema '/Users/doug/perl/cpantesters/schema/share/CPAN-Testers-Schema-0.022-MySQL.sql' to 'CPAN::Testers::Schema v0.023':; --- No differences found; +BEGIN; + +SET foreign_key_checks=0; + +CREATE TABLE IF NOT EXISTS `perl_version` ( + `version` varchar(255) NOT NULL, + `perl` varchar(32) NULL, + `patch` tinyint(1) NOT NULL DEFAULT 0, + `devel` tinyint(1) NOT NULL DEFAULT 0, + PRIMARY KEY (`version`) +); + +SET foreign_key_checks=1; + + +COMMIT; diff --git a/share/CPAN-Testers-Schema-0.022-0.023-SQLite.sql b/share/CPAN-Testers-Schema-0.022-0.023-SQLite.sql index e649ef2..2f330ed 100644 --- a/share/CPAN-Testers-Schema-0.022-0.023-SQLite.sql +++ b/share/CPAN-Testers-Schema-0.022-0.023-SQLite.sql @@ -1,4 +1,15 @@ -- Convert schema '/Users/doug/perl/cpantesters/schema/share/CPAN-Testers-Schema-0.022-SQLite.sql' to '/Users/doug/perl/cpantesters/schema/share/CPAN-Testers-Schema-0.023-SQLite.sql':; --- No differences found; +BEGIN; + +CREATE TABLE "perl_version" ( + "version" varchar(255) NOT NULL, + "perl" varchar(32), + "patch" tinyint(1) NOT NULL DEFAULT 0, + "devel" tinyint(1) NOT NULL DEFAULT 0, + PRIMARY KEY ("version") +); + + +COMMIT; diff --git a/share/CPAN-Testers-Schema-0.023-MySQL.sql b/share/CPAN-Testers-Schema-0.023-MySQL.sql index fe1c860..092d4b8 100644 --- a/share/CPAN-Testers-Schema-0.023-MySQL.sql +++ b/share/CPAN-Testers-Schema-0.023-MySQL.sql @@ -1,6 +1,6 @@ -- -- Created by SQL::Translator::Producer::MySQL --- Created on Thu Apr 19 14:31:13 2018 +-- Created on Sun Apr 22 13:09:39 2018 -- SET foreign_key_checks=0; @@ -18,6 +18,19 @@ CREATE TABLE `metabase_user` ( UNIQUE `metabase_user_resource` (`resource`) ); +DROP TABLE IF EXISTS `perl_version`; + +-- +-- Table: `perl_version` +-- +CREATE TABLE `perl_version` ( + `version` varchar(255) NOT NULL, + `perl` varchar(32) NULL, + `patch` tinyint(1) NOT NULL DEFAULT 0, + `devel` tinyint(1) NOT NULL DEFAULT 0, + PRIMARY KEY (`version`) +); + DROP TABLE IF EXISTS `test_report`; -- diff --git a/share/CPAN-Testers-Schema-0.023-SQLite.sql b/share/CPAN-Testers-Schema-0.023-SQLite.sql index 5641d53..00c2b08 100644 --- a/share/CPAN-Testers-Schema-0.023-SQLite.sql +++ b/share/CPAN-Testers-Schema-0.023-SQLite.sql @@ -1,6 +1,6 @@ -- -- Created by SQL::Translator::Producer::SQLite --- Created on Thu Apr 19 14:31:14 2018 +-- Created on Sun Apr 22 13:09:39 2018 -- BEGIN TRANSACTION; @@ -19,6 +19,19 @@ CREATE TABLE metabase_user ( CREATE UNIQUE INDEX metabase_user_resource ON metabase_user (resource); +-- +-- Table: perl_version +-- +DROP TABLE perl_version; + +CREATE TABLE perl_version ( + version varchar(255) NOT NULL, + perl varchar(32), + patch tinyint(1) NOT NULL DEFAULT 0, + devel tinyint(1) NOT NULL DEFAULT 0, + PRIMARY KEY (version) +); + -- -- Table: test_report -- diff --git a/t/result/perl_version.t b/t/result/perl_version.t new file mode 100644 index 0000000..e425cc8 --- /dev/null +++ b/t/result/perl_version.t @@ -0,0 +1,58 @@ + +=head1 DESCRIPTION + +This file tests the L class. + +=head1 SEE ALSO + +L, L + +=cut + +use CPAN::Testers::Schema::Base 'Test'; + +subtest 'fill in data' => sub { + my $schema = prepare_temp_schema; + + subtest 'stable perl' => sub { + my $row = $schema->resultset( 'PerlVersion' )->create({ version => '5.5.1' }); + is $row->perl, '5.5.1', 'parsed Perl version is correct'; + is $row->patch, 0, 'not a patch perl'; + is $row->devel, 0, 'not a devel perl'; + }; + + subtest 'devel perl' => sub { + my $row = $schema->resultset( 'PerlVersion' )->create({ version => '5.7.1' }); + is $row->perl, '5.7.1', 'parsed Perl version is correct'; + is $row->patch, 0, 'not a patch perl'; + is $row->devel, 1, 'a devel perl'; + }; + + subtest 'patch perl' => sub { + my $row = $schema->resultset( 'PerlVersion' )->create({ version => '5.9.6 patch 31753' }); + is $row->perl, '5.9.6', 'parsed Perl version is correct'; + is $row->patch, 1, 'a patch perl'; + is $row->devel, 1, 'a devel perl'; + + $row = $schema->resultset( 'PerlVersion' )->create({ version => '5.10.0 patch GitLive-maint-5.10-1462-g178839f' }); + is $row->perl, '5.10.0', 'parsed Perl version is correct'; + is $row->patch, 1, 'a patch perl'; + is $row->devel, 0, 'not a devel perl'; + }; + + subtest 'leading v' => sub { + my $row = $schema->resultset( 'PerlVersion' )->create({ version => 'v5.15.0' }); + is $row->perl, '5.15.0', 'parsed Perl version is correct'; + is $row->patch, 0, 'not a patch perl'; + is $row->devel, 1, 'a devel perl'; + }; + + subtest 'release candidates' => sub { + my $row = $schema->resultset( 'PerlVersion' )->create({ version => '5.20.0 RC0' }); + is $row->perl, '5.20.0', 'parsed Perl version is correct'; + is $row->patch, 0, 'not a patch perl'; + is $row->devel, 1, 'a devel perl'; + }; +}; + +done_testing; diff --git a/t/resultset/perl_version.t b/t/resultset/perl_version.t new file mode 100644 index 0000000..8309c23 --- /dev/null +++ b/t/resultset/perl_version.t @@ -0,0 +1,36 @@ + +=head1 DESCRIPTION + +This file tests the L module which +queries for L objects. + +=head1 SEE ALSO + +=over + +=item L + +=back + +=cut + +use CPAN::Testers::Schema::Base 'Test'; + +my $schema = prepare_temp_schema; +my $rs = $schema->resultset( 'PerlVersion' ); +$rs->find_or_create({ version => '5.9.5' }); +$rs->find_or_create({ version => '5.5.1' }); +$rs->find_or_create({ version => '5.23.5 patch 12' }); +$rs->find_or_create({ version => '5.24.0 RC0' }); +$rs->find_or_create({ version => '5.11.2' }); +$rs->find_or_create({ version => '5.10.1' }); + +subtest 'maturity' => sub { + my $rs = $schema->resultset( 'PerlVersion' )->maturity( 'stable' ); + is_deeply [ sort map { $_->perl } $rs->all ], [qw( 5.10.1 5.5.1 )]; + $rs = $schema->resultset( 'PerlVersion' )->maturity( 'dev' ); + is_deeply [ sort map { $_->perl } $rs->all ], [qw( 5.11.2 5.23.5 5.24.0 5.9.5 )]; +}; + +done_testing; +