File Coverage

blib/lib/Test/MinimumVersion.pm

Criterion	Covered	Total	%
statement	72	91	79.1
branch	10	24	41.6
condition	9	30	30.0
subroutine	15	20	75.0
pod	6	6	100.0
total	112	171	65.5

use 5.006;
use strict;
use warnings;
package Test::MinimumVersion;
$Test::MinimumVersion::VERSION = '0.101082';
# ABSTRACT: does your code require newer perl than you think?
use base 'Exporter';

#pod =head1 SYNOPSIS
#pod
#pod Example F<minimum-perl.t>:
#pod
#pod   #!perl
#pod   use Test::MinimumVersion;
#pod   all_minimum_version_ok('5.008');
#pod
#pod =cut

use CPAN::Meta;
use File::Find::Rule;
use File::Find::Rule::Perl;
use Perl::MinimumVersion 1.32; # numerous bugfies
use version 0.70;

use Test::Builder;
@Test::MinimumVersion::EXPORT = qw(
  minimum_version_ok
  all_minimum_version_ok
  all_minimum_version_from_metayml_ok
  all_minimum_version_from_metajson_ok
  all_minimum_version_from_mymetayml_ok
  all_minimum_version_from_mymetajson_ok
);

sub import {
  my($self) = shift;
  my $pack = caller;

  my $Test = Test::Builder->new;

  $Test->exported_to($pack);
  $Test->plan(@_);

  $self->export_to_level(1, $self, @Test::MinimumVersion::EXPORT);
}

sub _objectify_version {
  my ($version) = @_;
  $version = eval { $version->isa('version') }
           ? $version
           : version->new($version);
}

#pod =func minimum_version_ok
#pod
#pod   minimum_version_ok($file, $version);
#pod
#pod This test passes if the given file does not seem to require any version of perl
#pod newer than C<$version>, which may be given as a version string or a version
#pod object.
#pod
#pod =cut

sub minimum_version_ok {
  my ($file, $version) = @_;

  my $Test = Test::Builder->new;

  $version = _objectify_version($version);

  my $pmv = Perl::MinimumVersion->new($file);

  unless (defined $pmv) {
    $Test->ok(0, $file);
    $Test->diag(
      "$file could not be parsed: " . PPI::Document->errstr
    );
    return;
  }

  my $explicit_minimum = $pmv->minimum_explicit_version || 0;
  my $minimum = $pmv->minimum_syntax_version($explicit_minimum) || 0;

  my $is_syntax = 1
    if $minimum and $minimum > $explicit_minimum;

  $minimum = $explicit_minimum
    if $explicit_minimum and $explicit_minimum > $minimum;

  my %min = $pmv->version_markers;

  if ($minimum <= $version) {
    $Test->ok(1, $file);
  } else {
    $Test->ok(0, $file);
    $Test->diag(
      "$file requires $minimum "
      . ($is_syntax ? 'due to syntax' : 'due to explicit requirement')
    );

    if ($is_syntax and my $markers = $min{ $minimum }) {
      $Test->diag("version markers for $minimum:");
      $Test->diag("- $_ ") for @$markers;
    }
  }
}

#pod =func all_minimum_version_ok
#pod
#pod   all_minimum_version_ok($version, \%arg);
#pod
#pod Given either a version string or a L<version> object, this routine produces a
#pod test plan (if there is no plan) and tests each relevant file with
#pod C<minimum_version_ok>.
#pod
#pod Relevant files are found by L<File::Find::Rule::Perl>.
#pod
#pod C<\%arg> is optional.  Valid arguments are:
#pod
#pod   paths   - in what paths to look for files; defaults to (bin, script, t, lib,
#pod             xt/smoke, and any .pm or .PL files in the current working
#pod             directory) if it contains files, they will be checked
#pod   no_plan - do not plan the tests about to be run
#pod   skip    - files to skip; this can be useful in weird cases like gigantic
#pod             files, files falsely detected as Perl, or code that uses
#pod             a source filter; this should be an arrayref of filenames
#pod
#pod =cut

sub all_minimum_version_ok {
  my ($version, $arg) = @_;
  $arg ||= {};
  $arg->{paths} ||= [
    qw(bin script lib t xt/smoke),
    glob("*.pm"),
    glob("*.PL"),
  ];

  $arg->{skip} ||= [];

  my $Test = Test::Builder->new;

  $version = _objectify_version($version);

  my @perl_files;
  for my $path (@{ $arg->{paths} }) {
    if (-f $path and -s $path) {
      push @perl_files, $path;
    } elsif (-d $path) {
      push @perl_files, File::Find::Rule->perl_file->in($path);
    }
  }

  my %skip = map {; $_ => 1 } @{ $arg->{skip} };
  @perl_files = grep {; ! $skip{$_} } @perl_files;

  unless ($Test->has_plan or $arg->{no_plan}) {
    $Test->plan(tests => scalar @perl_files);
  }

  minimum_version_ok($_, $version) for @perl_files;
}

#pod =func all_minimum_version_from_metayml_ok
#pod
#pod   all_minimum_version_from_metayml_ok(\%arg);
#pod
#pod This routine checks F<META.yml> for an entry in F<requires> for F<perl>.  If no
#pod META.yml file or no perl version is found, all tests are skipped.  If a version
#pod is found, the test proceeds as if C<all_minimum_version_ok> had been called
#pod with that version.
#pod
#pod =cut

sub __version_from_meta {
  my ($fn) = @_;

  my $meta = CPAN::Meta->load_file($fn, { lazy_validation => 1 })->as_struct;
  my $version = $meta->{prereqs}{runtime}{requires}{perl};
}

sub __from_meta {
  my ($fn, $arg) = @_;
  $arg ||= {};

  my $Test = Test::Builder->new;

  $Test->plan(skip_all => "$fn could not be found")
    unless -f $fn and -r _;

  $Test->plan(skip_all => "no minimum perl version could be determined")
    unless my $version = __version_from_meta($fn);

  all_minimum_version_ok($version, $arg);
}

sub all_minimum_version_from_metayml_ok {
  __from_meta('META.yml', @_);
}

#pod =func all_minimum_version_from_metajson_ok
#pod
#pod   all_minimum_version_from_metajson_ok(\%arg);
#pod
#pod This routine checks F<META.json> for an entry in F<requires> for F<perl>.  If
#pod no META.json file or no perl version is found, all tests are skipped.  If a
#pod version is found, the test proceeds as if C<all_minimum_version_ok> had been
#pod called with that version.
#pod
#pod =cut

sub all_minimum_version_from_metajson_ok { __from_meta('META.json', @_); }

#pod =func all_minimum_version_from_mymetayml_ok
#pod
#pod   all_minimum_version_from_mymetayml_ok(\%arg);
#pod
#pod This routine checks F<MYMETA.yml> for an entry in F<requires> for F<perl>.  If
#pod no MYMETA.yml file or no perl version is found, all tests are skipped.  If a
#pod version is found, the test proceeds as if C<all_minimum_version_ok> had been
#pod called with that version.
#pod
#pod =cut

sub all_minimum_version_from_mymetayml_ok { __from_meta('MYMETA.yml', @_); }

#pod =func all_minimum_version_from_mymetajson_ok
#pod
#pod   all_minimum_version_from_mymetajson_ok(\%arg);
#pod
#pod This routine checks F<MYMETA.json> for an entry in F<requires> for F<perl>.  If
#pod no MYMETA.json file or no perl version is found, all tests are skipped.  If a
#pod version is found, the test proceeds as if C<all_minimum_version_ok> had been
#pod called with that version.
#pod
#pod =cut

sub all_minimum_version_from_mymetajson_ok { __from_meta('MYMETA.json', @_); }

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test::MinimumVersion - does your code require newer perl than you think?

=head1 VERSION

version 0.101082

=head1 SYNOPSIS

Example F<minimum-perl.t>:

  #!perl
  use Test::MinimumVersion;
  all_minimum_version_ok('5.008');

=head1 FUNCTIONS

=head2 minimum_version_ok

  minimum_version_ok($file, $version);

This test passes if the given file does not seem to require any version of perl
newer than C<$version>, which may be given as a version string or a version
object.

=head2 all_minimum_version_ok

  all_minimum_version_ok($version, \%arg);

Given either a version string or a L<version> object, this routine produces a
test plan (if there is no plan) and tests each relevant file with
C<minimum_version_ok>.

Relevant files are found by L<File::Find::Rule::Perl>.

C<\%arg> is optional.  Valid arguments are:

  paths   - in what paths to look for files; defaults to (bin, script, t, lib,
            xt/smoke, and any .pm or .PL files in the current working
            directory) if it contains files, they will be checked
  no_plan - do not plan the tests about to be run
  skip    - files to skip; this can be useful in weird cases like gigantic
            files, files falsely detected as Perl, or code that uses
            a source filter; this should be an arrayref of filenames

=head2 all_minimum_version_from_metayml_ok

  all_minimum_version_from_metayml_ok(\%arg);

This routine checks F<META.yml> for an entry in F<requires> for F<perl>.  If no
META.yml file or no perl version is found, all tests are skipped.  If a version
is found, the test proceeds as if C<all_minimum_version_ok> had been called
with that version.

=head2 all_minimum_version_from_metajson_ok

  all_minimum_version_from_metajson_ok(\%arg);

This routine checks F<META.json> for an entry in F<requires> for F<perl>.  If
no META.json file or no perl version is found, all tests are skipped.  If a
version is found, the test proceeds as if C<all_minimum_version_ok> had been
called with that version.

=head2 all_minimum_version_from_mymetayml_ok

  all_minimum_version_from_mymetayml_ok(\%arg);

This routine checks F<MYMETA.yml> for an entry in F<requires> for F<perl>.  If
no MYMETA.yml file or no perl version is found, all tests are skipped.  If a
version is found, the test proceeds as if C<all_minimum_version_ok> had been
called with that version.

=head2 all_minimum_version_from_mymetajson_ok

  all_minimum_version_from_mymetajson_ok(\%arg);

This routine checks F<MYMETA.json> for an entry in F<requires> for F<perl>.  If
no MYMETA.json file or no perl version is found, all tests are skipped.  If a
version is found, the test proceeds as if C<all_minimum_version_ok> had been
called with that version.

=head1 AUTHOR

Ricardo Signes

=head1 CONTRIBUTORS

=for stopwords Ricardo SIGNES Steve Hay

=over 4

=item *

Ricardo SIGNES <[e-mail]>

=item *

Ricardo SIGNES <[e-mail]>

=item *

Steve Hay <[e-mail]>

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2007 by Ricardo Signes.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut