File Coverage

blib/lib/Devel/Deprecations/Environmental/Plugin/OldPerl.pm
Criterion Covered Total %
statement 21 21 100.0
branch 2 2 100.0
condition 2 2 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 34 34 100.0


line stmt bran cond sub pod time code
1              
2             use strict;
3 2     2   1040 use warnings;
  2         4  
  2         50  
4 2     2   8  
  2         5  
  2         48  
5             use base 'Devel::Deprecations::Environmental';
6 2     2   11  
  2         12  
  2         311  
7             use Config;
8 2     2   12  
  2         5  
  2         585  
9             our $VERSION = '1.000';
10              
11             =head1 NAME
12              
13             Devel::Deprecations::Environmental::Plugin::OldPerl
14              
15             =head1 DESCRIPTION
16              
17             A plugin for L<Devel::Deprecations::Environmental> to emit warnings when perl is too old
18              
19             =head1 SYNOPSIS
20              
21             If you want to say that perl 5.14.0 is the earliest that you will support:
22              
23             use Devel::Deprecations::Environmental OldPerl => { older_than '5.14.0' }
24              
25             =head1 AUTHOR, LICENCE and COPYRIGHT
26              
27             Copyright 2022 David Cantrell E<lt>F<david@cantrell.org.uk>E<gt>
28              
29             This software is free-as-in-speech software, and may be used, distributed, and
30             modified under the terms of either the GNU General Public Licence version 2 or
31             the Artistic Licence. It's up to you which one you use. The full text of the
32             licences can be found in the files GPL2.txt and ARTISTIC.txt, respectively.
33              
34             =head1 CONSPIRACY
35              
36             This module is also free-as-in-mason software.
37              
38             =cut
39              
40              
41 2     2 1 17 my $minimum_version = $_[-1]->{older_than} ||
42             die(__PACKAGE__.": 'older_than' parameter is mandatory\n");
43             my @minimum_version_parts = (split(/\./, "$minimum_version", 3), 0, 0)[0..2];
44              
45 5   100 5 1 26 # can't use /\D/a because /a is a 5.14-ism
46 4         16 if(grep { /[^0-9]/ } @minimum_version_parts) {
47             die(__PACKAGE__.": $minimum_version isn't a plausible perl version\n")
48             }
49 4 100       8  
  12         40  
50 1         12 my @current_version_parts = split(/\./, $Config{version});
51              
52             _parts_to_int(@current_version_parts) < _parts_to_int(@minimum_version_parts);
53 3         21 }
54              
55 3         11 return 1000000 * $_[0] +
56             1000 * $_[1] +
57             $_[2]
58             }
59 6     6   30  
60             1;