File Coverage

blib/lib/Module/Extract/DeclaredVersion.pm
Criterion Covered Total %
statement 54 56 96.4
branch 10 12 83.3
condition 4 6 66.6
subroutine 14 14 100.0
pod 4 4 100.0
total 86 92 93.4


line stmt bran cond sub pod time code
1 2     2   2055 use utf8;
  2         25  
  2         9  
2 2     2   57 use v5.10;
  2         6  
3              
4             package Module::Extract::DeclaredVersion;
5 2     2   10 use strict;
  2         4  
  2         31  
6              
7 2     2   8 use warnings;
  2         4  
  2         60  
8 2     2   9 no warnings;
  2         5  
  2         70  
9              
10 2     2   882 use subs qw();
  2         39  
  2         955  
11              
12             our $VERSION = '1.022';
13              
14             =encoding utf8
15              
16             =head1 NAME
17              
18             Module::Extract::DeclaredVersion - Extract the version of Perl a module declares
19              
20             =head1 SYNOPSIS
21              
22             use Module::Extract::DeclaredVersion;
23              
24             my $extor = Module::Extract::DeclaredVersion->new;
25              
26             my $version = $extor->get_declared_version( $file );
27             if( $extor->error ) { ... }
28              
29             =head1 DESCRIPTION
30              
31             Extract the largest declared Perl version and returns it as a
32             version object. For instance, in a script you might have:
33              
34             use v5.16;
35              
36             This module will extract that C and return it.
37              
38             This module tries to handle any format that PPI will recognize, passing
39             them through version.pm to normalize them.
40              
41             =cut
42              
43             =over 4
44              
45             =item new
46              
47             Makes an object. The object doesn't do anything just yet, but you need
48             it to call the methods.
49              
50             =cut
51              
52             sub new {
53 1     1 1 413 my $class = shift;
54              
55 1         2 my $self = bless {}, $class;
56              
57 1         3 $self->init;
58              
59 1         2 $self;
60             }
61              
62             =item init
63              
64             Set up the object. You shouldn't need to call this yourself. You can
65             override it though!
66              
67             =cut
68              
69             sub init {
70 1     1 1 3 $_[0]->_clear_error;
71             }
72              
73             =item get_declared_version( FILE )
74              
75             Extracts all of the declared minimum versions for Perl, sorts them,
76             and returns the largest a version object.
77              
78             =cut
79              
80             sub get_declared_version {
81 3     3 1 2444 my( $self, $file ) = @_;
82              
83 3         8 $self->_clear_error;
84              
85 3         6 my $versions = $self->_get_ppi_for_file( $file );
86 3 100       3664 return unless defined $versions;
87              
88             my @sorted = sort {
89 2         11 eval { version->parse( $b->{version} ) }
  1         10  
90             <=>
91 1         2 eval { version->parse( $a->{version} ) }
  1         9  
92             } @$versions;
93              
94 2         6 eval { version->parse( $sorted[0]->{version} ) };
  2         23  
95             }
96              
97             sub _get_ppi_for_file {
98 3     3   6 my( $self, $file ) = @_;
99              
100 3 100       38 unless( -e $file ) {
101 1         5 $self->_set_error( ref( $self ) . ": File [$file] does not exist!" );
102 1         2 return;
103             }
104              
105 2         436 require PPI;
106              
107 2         104062 my $Document = eval { PPI::Document->new( $file ) };
  2         31  
108 2 50       68928 unless( $Document ) {
109 0         0 $self->_set_error( ref( $self ) . ": Could not parse file [$file]" );
110 0         0 return;
111             }
112              
113             my $modules = $Document->find(
114             sub {
115 666 100 66 666   7186 $_[1]->isa( 'PPI::Statement::Include' ) &&
116             ( $_[1]->type eq 'use' || $_[1]->type eq 'require' )
117             }
118 2         37 );
119              
120 2 50       30 return unless $modules;
121              
122 2         4 my %Seen;
123             my @versions =
124 15         84 grep { $_->{version_literal} }
125             map {
126 2         24 my $literal = $_->version_literal;
  15         457  
127 15         340 $literal =~ s/\s//g;
128 15 100       32 $literal = undef unless length $literal;
129 15   66     41 my $hash = {
130             version => $_->version,
131             version_literal => ( $literal // $_->version ), #/
132             };
133             } @$modules;
134              
135 2         15 return \@versions;
136             }
137              
138             =item error
139              
140             Return the error from the last call to C.
141              
142             =cut
143              
144 1     1   2 sub _set_error { $_[0]->{error} = $_[1]; }
145              
146 4     4   10 sub _clear_error { $_[0]->{error} = '' }
147              
148 3     3 1 32 sub error { $_[0]->{error} }
149              
150             =back
151              
152             =head1 TO DO
153              
154             =over 4
155              
156             =item * Make it recursive, so it scans the source for any module that it finds.
157              
158             =back
159              
160             =head1 SEE ALSO
161              
162             L
163              
164             =head1 SOURCE AVAILABILITY
165              
166             The source code is in Github
167              
168             https://github.com/briandfoy/module-extract-declaredversion
169              
170             =head1 AUTHOR
171              
172             brian d foy, C<< >>
173              
174             =head1 COPYRIGHT AND LICENSE
175              
176             Copyright © 2011-2018, brian d foy . All rights reserved.
177              
178             You may redistribute this under the terms of the Artistic License 2.0.
179              
180             =cut
181              
182             1;