3819861203

Build # 3819861203

Build Type

push

github

Committed by 'brian d foy'

Commit Message

'Bump copyright date'

Run Details

37 of 39 relevant lines covered (94.87%)

20.38 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

94.87

/lib/Module/Extract/DeclaredMinimumPerl.pm

use utf8;
use v5.10;

package Module::Extract::DeclaredMinimumPerl;
use strict;

use warnings;
no warnings;

our $VERSION = '1.023';

=encoding utf8

=head1 NAME

Module::Extract::DeclaredMinimumPerl - Extract the version of Perl a module declares

=head1 SYNOPSIS

        use Module::Extract::DeclaredMinimumPerl;

        my $extor = Module::Extract::DeclaredMinimumPerl->new;

        my $version = $extor->get_minimum_declared_perl( $file );
        if( $extor->error ) { ... }

=head1 DESCRIPTION

Extract the largest declared Perl version and returns it as a
version object. For instance, in a script you might have:

  use v5.16;

This module will extract that C<v5.16> and return it.

This module tries to handle any format that PPI will recognize, passing
them through version.pm to normalize them.

=cut

=over 4

=item new

Makes an object. The object doesn't do anything just yet, but you need
it to call the methods.

=cut

sub new {
        my $class = shift;

        my $self = bless {}, $class;

        $self->init;

        $self;
        }

=item init

Set up the object. You shouldn't need to call this yourself. You can
override it though!

=cut

sub init {
        $_[0]->_clear_error;
        }

=item get_minimum_declared_perl( FILE )

Extracts all of the declared minimum versions for Perl, sorts them,
and returns the largest a version object.

=cut

sub get_minimum_declared_perl {
        my( $self, $file ) = @_;

        $self->_clear_error;

        my $versions = $self->_get_ppi_for_file( $file );
        return unless defined $versions;

        my @sorted = sort {
                eval { version->parse( $b->{version} ) }
                  <=>
                eval { version->parse( $a->{version} ) }
                } @$versions;

        eval { version->parse( $sorted[0]->{version} ) };
        }

sub _get_ppi_for_file {
        my( $self, $file ) = @_;

        unless( -e $file ) {
                $self->_set_error( ref( $self ) . ": File [$file] does not exist!" );
                return;
                }

        require PPI;

        my $Document = eval { PPI::Document->new( $file ) };
        unless( $Document ) {
                $self->_set_error( ref( $self ) . ": Could not parse file [$file]" );
                return;
                }

        my $modules = $Document->find(
                sub {
                        $_[1]->isa( 'PPI::Statement::Include' )  &&
                                ( $_[1]->type eq 'use' || $_[1]->type eq 'require' )
                        }
                );

        return unless $modules;

        my %Seen;
        my @versions =
                grep { $_->{version_literal} }
                map  {
                        my $literal = $_->version_literal;
                        $literal =~ s/\s//g;
                        $literal = undef unless length $literal;
                        my $hash = {
                                version         => $_->version,
                                version_literal => ( $literal // $_->version ), #/
                                };
                        } @$modules;

        return \@versions;
        }

=item error

Return the error from the last call to C<get_minimum_declared_perl>.

=cut

sub _set_error   { $_[0]->{error} = $_[1]; }

sub _clear_error { $_[0]->{error} = '' }

sub error        { $_[0]->{error} }

=back

=head1 TO DO

=over 4

=item * Make it recursive, so it scans the source for any module that it finds.

=back

=head1 SEE ALSO

L<Module::Extract::Use>

=head1 SOURCE AVAILABILITY

The source code is in Github:

        https://github.com/briandfoy/module-extract-declaredminimumperl

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright © 2011-2023, brian d foy <bdfoy@cpan.org>. All rights reserved.

You may redistribute this under the terms of the Artistic License 2.0.

=cut

1;

1	use utf8;	3✔
2	use v5.10;	3✔
3
4	package Module::Extract::DeclaredMinimumPerl;
5	use strict;	3✔
6
7	use warnings;	3✔
8	no warnings;	3✔
9
10	our $VERSION = '1.023';
11
12	=encoding utf8
13
14	=head1 NAME
15
16	Module::Extract::DeclaredMinimumPerl - Extract the version of Perl a module declares
17
18	=head1 SYNOPSIS
19
20	use Module::Extract::DeclaredMinimumPerl;
21
22	my $extor = Module::Extract::DeclaredMinimumPerl->new;
23
24	my $version = $extor->get_minimum_declared_perl( $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<v5.16> 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	my $class = shift;	1✔
52
53	my $self = bless {}, $class;	1✔
54
55	$self->init;	1✔
56
57	$self;	1✔
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	$_[0]->_clear_error;	1✔
69	}
70
71	=item get_minimum_declared_perl( 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_minimum_declared_perl {
79	my( $self, $file ) = @_;	3✔
80
81	$self->_clear_error;	3✔
82
83	my $versions = $self->_get_ppi_for_file( $file );	3✔
84	return unless defined $versions;	3✔
85
86	my @sorted = sort {
87	eval { version->parse( $b->{version} ) }	2✔
88	<=>
89	eval { version->parse( $a->{version} ) }	1✔
90	} @$versions;
91
92	eval { version->parse( $sorted[0]->{version} ) };	2✔
93	}
94
95	sub _get_ppi_for_file {
96	my( $self, $file ) = @_;	3✔
97
98	unless( -e $file ) {	3✔
99	$self->_set_error( ref( $self ) . ": File [$file] does not exist!" );	1✔
100	return;	1✔
101	}
102
103	require PPI;	2✔
104
105	my $Document = eval { PPI::Document->new( $file ) };	2✔
106	unless( $Document ) {	2✔
107	$self->_set_error( ref( $self ) . ": Could not parse file [$file]" );	×
108	return;	×
109	}
110
111	my $modules = $Document->find(
112	sub {
113	$_[1]->isa( 'PPI::Statement::Include' ) &&	666✔
114	( $_[1]->type eq 'use' \|\| $_[1]->type eq 'require' )
115	}
116	);	2✔
117
118	return unless $modules;	2✔
119
120	my %Seen;	2✔
121	my @versions =
122	grep { $_->{version_literal} }	15✔
123	map {
124	my $literal = $_->version_literal;	2✔
125	$literal =~ s/\s//g;	15✔
126	$literal = undef unless length $literal;	15✔
127	my $hash = {	15✔
128	version => $_->version,
129	version_literal => ( $literal // $_->version ), #/
130	};
131	} @$modules;
132
133	return \@versions;	2✔
134	}
135
136	=item error
137
138	Return the error from the last call to C<get_minimum_declared_perl>.
139
140	=cut
141
142	sub _set_error { $_[0]->{error} = $_[1]; }	1✔
143
144	sub _clear_error { $_[0]->{error} = '' }	4✔
145
146	sub error { $_[0]->{error} }	3✔
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<Module::Extract::Use>
161
162	=head1 SOURCE AVAILABILITY
163
164	The source code is in Github:
165
166	https://github.com/briandfoy/module-extract-declaredminimumperl
167
168	=head1 AUTHOR
169
170	brian d foy, C<< <bdfoy@cpan.org> >>
171
172	=head1 COPYRIGHT AND LICENSE
173
174	Copyright © 2011-2023, brian d foy <bdfoy@cpan.org>. All rights reserved.
175
176	You may redistribute this under the terms of the Artistic License 2.0.
177
178	=cut
179
180	1;

briandfoy / module-extract-declaredminimumperl / 3819861203

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous