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