File Coverage

blib/lib/Module/Extract/DeclaredVersion.pm
Criterion Covered Total %
statement 51 53 96.2
branch 10 12 83.3
condition 4 6 66.6
subroutine 13 13 100.0
pod 4 4 100.0
total 82 88 93.1


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