File Coverage

blib/lib/Sys/Linux/KernelVersion.pm
Criterion Covered Total %
statement 39 47 82.9
branch 11 16 68.7
condition 12 24 50.0
subroutine 12 13 92.3
pod 4 5 80.0
total 78 105 74.2


line stmt bran cond sub pod time code
1             package Sys::Linux::KernelVersion;
2              
3             # ABSTRACT: Gives tools for checking the current running linux kernel version
4              
5 2     2   213666 use v5.8.3;
  2         26  
6 2     2   11 use strict;
  2         5  
  2         44  
7 2     2   10 use warnings;
  2         5  
  2         84  
8              
9             our $VERSION = '0.100';
10 2     2   10 use Exporter 'import';
  2         5  
  2         1571  
11              
12             our @EXPORT_OK = qw/is_linux_kernel get_kernel_version is_at_least_kernel_version is_development_kernel stringify_kernel_version/;
13              
14             # not a complicated check, probably doesn't need to exist either but sure
15 1     1 1 134 sub is_linux_kernel { $^O eq 'linux' }
16              
17             my $linux_version;
18              
19             sub get_kernel_version {
20             # cache the result, it shouldn't ever change while we run. if it does TS for you.
21 2 100   2 1 9 return $linux_version if $linux_version;
22              
23 1 50       55 open(my $fh, "<", "/proc/version") or die "Couldn't open /proc/version : $!";
24              
25 1         31 my $line = <$fh>;
26              
27 1 50       19 close($fh) or die "Couldn't close the handle for /proc/version $!";
28              
29 1         7 $linux_version = _parse_version_line($line);
30             }
31              
32             sub _parse_version_spec {
33 42     42   11211 my $spec = shift;
34 42 50       282 if ($spec =~ /^(\d+)\.(\d+)\.(\d+)(-\S+)?$/) {
35 42         178 my ($major, $minor, $revision, $subpart) = ($1, $2, $3, $4);
36              
37 42   100     370 $linux_version = {major => $major, minor => $minor, revision => $revision, subpart => $subpart, subparts => [split /-/, $subpart||""]};
38             } else {
39 0         0 die "Invalid version spec";
40             }
41             }
42              
43             # TODO parse the compiler and other version info too? I'm not interested in it and I don't know if they're stable formatting wise
44             sub _parse_version_line {
45 5     5   1812 my $line = shift;
46              
47 5 50       37 if ($line =~ /^Linux version (\S+) .*$/) {
48 5         15 return _parse_version_spec($1);
49             } else {
50 0         0 die "Couldn't parse [$line]";
51             }
52             }
53              
54             sub _cmp_version {
55 19     19   51 my ($left, $right) = @_;
56              
57 19 50 33     192 unless (defined($left->{major}) && defined($left->{minor}) && defined($left->{revision}) &&
      33        
      33        
      33        
      33        
58             defined($right->{major}) && defined($right->{minor}) && defined($right->{revision})) {
59 0         0 die "Invalid version spec provided";
60             }
61              
62 19   66     88 return $left->{major} <=> $right->{major} || $left->{minor} <=> $right->{minor} || $left->{revision} <=> $right->{revision};
63             }
64              
65             sub is_at_least_kernel_version {
66 0     0 1 0 my $input = shift; # just a string as input
67              
68 0         0 my $running_version = get_version();
69 0         0 my $input_version = _parse_version($input);
70              
71 0         0 my $cmp = _cmp_version($running_version, $input_version);
72              
73 0         0 return $cmp != -1;
74             }
75              
76             # Is this a development kernel
77             sub is_development_kernel {
78 1     1 1 8 my $running_version = get_kernel_version();
79              
80 1         4 return _is_development($running_version);
81             }
82              
83             sub _is_development {
84 19     19   5640 my $version = shift;
85              
86 19         42 my $last_dev_rev = _parse_version_spec("2.5.9999"); # last one where the even/odd minor number was a thing
87              
88 19 100       46 if (_cmp_version($last_dev_rev, $version) != -1) {
89 10         19 my $minor = $version->{minor};
90              
91 10 100       51 return 1 if ($minor % 2);
92 2         10 return 0;
93             } else {
94             # There's no longer any proper development series like there used to be, but there are -rcN kernels during development, these should count
95 9   100     31 my $subpart = $version->{subpart} || "";
96            
97 9         49 return ($subpart =~ /-rc\d/);
98             }
99             }
100              
101             sub stringify_kernel_version {
102 1     1 0 6 my $version = shift;
103              
104 1   50     11 sprintf "%d.%d.%d%s", $version->{major}, $version->{minor}, $version->{revision}, $version->{subpart}||"";
105             }
106              
107             1;
108              
109             __END__