File Coverage

inc/Linux-Distribution/lib/Linux/Distribution.pm
Criterion Covered Total %
statement 35 67 52.2
branch 8 30 26.6
condition 4 20 20.0
subroutine 8 8 100.0
pod 0 3 0.0
total 55 128 42.9


line stmt bran cond sub pod time code
1             package Linux::Distribution;
2              
3 1     1   9291 use 5.006000;
  1         5  
4 1     1   9 use strict;
  1         2  
  1         41  
5 1     1   8 use warnings;
  1         3  
  1         1865  
6              
7             require Exporter;
8              
9             our @ISA = qw(Exporter);
10              
11             our @EXPORT_OK = qw( distribution_name distribution_version );
12              
13             our $VERSION = '0.21';
14              
15             our $release_files_directory='/etc';
16             our $standard_release_file = 'lsb-release';
17              
18             our %release_files = (
19             'gentoo-release' => 'gentoo',
20             'fedora-release' => 'fedora',
21             'centos-release' => 'centos',
22             'enterprise-release' => 'oracle enterprise linux',
23             'turbolinux-release' => 'turbolinux',
24             'mandrake-release' => 'mandrake',
25             'mandrakelinux-release' => 'mandrakelinux',
26             'debian_version' => 'debian',
27             'debian_release' => 'debian',
28             'SuSE-release' => 'suse',
29             'knoppix-version' => 'knoppix',
30             'yellowdog-release' => 'yellowdog',
31             'slackware-version' => 'slackware',
32             'slackware-release' => 'slackware',
33             'redflag-release' => 'redflag',
34             'redhat-release' => 'redhat',
35             'redhat_version' => 'redhat',
36             'conectiva-release' => 'conectiva',
37             'immunix-release' => 'immunix',
38             'tinysofa-release' => 'tinysofa',
39             'trustix-release' => 'trustix',
40             'adamantix_version' => 'adamantix',
41             'yoper-release' => 'yoper',
42             'arch-release' => 'arch',
43             'libranet_version' => 'libranet',
44             'va-release' => 'va-linux',
45             'pardus-release' => 'pardus',
46             'system-release' => 'amazon',
47             );
48              
49             our %version_match = (
50             'gentoo' => 'Gentoo Base System release (.*)',
51             'debian' => '(.+)',
52             'suse' => 'VERSION = (.*)',
53             'fedora' => 'Fedora(?: Core)? release (\d+) \(',
54             'redflag' => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
55             'redhat' => 'Red Hat(?: Enterprise)? Linux(?: Server)? release (.*) \(',
56             'oracle enterprise linux' => 'Enterprise Linux Server release (.+) \(',
57             'slackware' => '^Slackware (.+)$',
58             'pardus' => '^Pardus (.+)$',
59             'centos' => '^CentOS(?: Linux)? release (.+)(?:\s\(Final\))',
60             'scientific' => '^Scientific Linux release (.+) \(',
61             'amazon' => 'Amazon Linux AMI release (.+)$',
62             );
63              
64              
65             if ($^O ne 'linux') {
66             # require Carp;
67             # Carp::croak('you are trying to use a linux specific module on a different OS');
68             }
69              
70             sub new {
71 1     1 0 17 my %self = (
72             'DISTRIB_ID' => '',
73             'DISTRIB_RELEASE' => '',
74             'DISTRIB_CODENAME' => '',
75             'DISTRIB_DESCRIPTION' => '',
76             'release_file' => '',
77             'pattern' => ''
78             );
79            
80 1         5 return bless \%self;
81             }
82              
83             sub distribution_name {
84 1   33 1 0 17 my $self = shift || new();
85 1         2 my $distro;
86 1 50       8 if ($distro = $self->_get_lsb_info()){
87 1 50       13 return $distro if ($distro);
88             }
89              
90 0         0 foreach (qw(enterprise-release fedora-release)) {
91 0 0 0     0 if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){
92 0 0 0     0 if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){
93 0         0 $self->{'DISTRIB_ID'} = $release_files{$_};
94 0         0 $self->{'release_file'} = $_;
95 0         0 return $self->{'DISTRIB_ID'};
96             }
97             }
98             }
99              
100 0         0 foreach (keys %release_files) {
101 0 0 0     0 if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){
102 0 0 0     0 if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){
103 0 0       0 if ( $release_files{$_} eq 'redhat' ) {
104 0         0 foreach my $rhel_deriv ('centos','scientific',) {
105 0         0 $self->{'pattern'} = $version_match{$rhel_deriv};
106 0         0 $self->{'release_file'}='redhat-release';
107 0 0       0 if ( $self->_get_file_info() ) {
108 0         0 $self->{'DISTRIB_ID'} = $rhel_deriv;
109 0         0 $self->{'release_file'} = $_;
110 0         0 return $self->{'DISTRIB_ID'};
111             }
112             }
113 0         0 $self->{'pattern'}='';
114             }
115 0         0 $self->{'release_file'} = $_;
116 0         0 $self->{'DISTRIB_ID'} = $release_files{$_};
117 0         0 return $self->{'DISTRIB_ID'};
118             }
119             }
120             }
121             undef
122 0         0 }
123              
124             sub distribution_version {
125 1   33 1 0 7 my $self = shift || new();
126 1         2 my $release;
127 1 50       5 return $release if ($release = $self->_get_lsb_info('DISTRIB_RELEASE'));
128 0 0       0 if (! $self->{'DISTRIB_ID'}){
129 0 0       0 $self->distribution_name() or die 'No version because no distro.';
130             }
131 0         0 $self->{'pattern'} = $version_match{$self->{'DISTRIB_ID'}};
132 0         0 $release = $self->_get_file_info();
133 0         0 $self->{'DISTRIB_RELEASE'} = $release;
134 0         0 return $release;
135             }
136              
137             sub _get_lsb_info {
138 2     2   6 my $self = shift;
139 2   100     18 my $field = shift || 'DISTRIB_ID';
140 2         6 my $tmp = $self->{'release_file'};
141 2 50       143 if ( -r "$release_files_directory/" . $standard_release_file ) {
142 2         6 $self->{'release_file'} = $standard_release_file;
143 2         8 $self->{'pattern'} = $field . '=(.+)';
144 2         9 my $info = $self->_get_file_info();
145 2 50       10 if ($info){
146 2         7 $self->{$field} = $info;
147 2         19 return $info
148             }
149             }
150 0         0 $self->{'release_file'} = $tmp;
151 0         0 $self->{'pattern'} = '';
152 0         0 undef;
153             }
154              
155             sub _get_file_info {
156 2     2   5 my $self = shift;
157 2 50       230 open my $fh, '<', "$release_files_directory/" . $self->{'release_file'} or die 'Cannot open file: '.$release_files_directory.'/' . $self->{'release_file'};
158 2         6 my $info = '';
159 2         6 local $_;
160 2         1495 while (<$fh>){
161 3         10 chomp $_;
162 3         83 ($info) = $_ =~ m/$self->{'pattern'}/;
163 3 100       56 return "\L$info" if $info;
164             }
165 0           undef;
166             }
167              
168             1;
169             __END__