File Coverage

blib/lib/Siebel/AssertOS/Linux/Distribution.pm
Criterion Covered Total %
statement 33 68 48.5
branch 6 30 20.0
condition 2 20 10.0
subroutine 7 8 87.5
pod 0 3 0.0
total 48 129 37.2


line stmt bran cond sub pod time code
1             package Siebel::AssertOS::Linux::Distribution;
2              
3 2     2   33 use 5.006000;
  2         4  
  2         49  
4 2     2   4 use strict;
  2         2  
  2         42  
5 2     2   5 use warnings;
  2         1  
  2         1269  
6              
7             require Exporter;
8             our @ISA = qw(Exporter);
9             our @EXPORT_OK = qw( distribution_name distribution_version );
10              
11             our $VERSION = "0.07";
12              
13             our $release_files_directory = '/etc';
14             our $standard_release_file = 'lsb-release';
15              
16             our %release_files = (
17             'gentoo-release' => 'gentoo',
18             'fedora-release' => 'fedora',
19             'centos-release' => 'centos',
20             'enterprise-release' => 'oracle enterprise linux',
21             'turbolinux-release' => 'turbolinux',
22             'mandrake-release' => 'mandrake',
23             'mandrakelinux-release' => 'mandrakelinux',
24             'debian_version' => 'debian',
25             'debian_release' => 'debian',
26             'SuSE-release' => 'suse',
27             'knoppix-version' => 'knoppix',
28             'yellowdog-release' => 'yellowdog',
29             'slackware-version' => 'slackware',
30             'slackware-release' => 'slackware',
31             'redflag-release' => 'redflag',
32             'redhat-release' => 'redhat',
33             'redhat_version' => 'redhat',
34             'conectiva-release' => 'conectiva',
35             'immunix-release' => 'immunix',
36             'tinysofa-release' => 'tinysofa',
37             'trustix-release' => 'trustix',
38             'adamantix_version' => 'adamantix',
39             'yoper-release' => 'yoper',
40             'arch-release' => 'arch',
41             'libranet_version' => 'libranet',
42             'va-release' => 'va-linux',
43             'pardus-release' => 'pardus',
44             'system-release' => 'amazon',
45             );
46              
47             our %version_match = (
48             'gentoo' => 'Gentoo Base System release (.*)',
49             'debian' => '(.+)',
50             'suse' => 'VERSION = (.*)',
51             'fedora' => 'Fedora(?: Core)? release (\d+) \(',
52             'redflag' => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
53             'redhat' => 'Red Hat(?: Enterprise)? Linux(?: Server)? release (.*) \(',
54             'oracle enterprise linux' => 'Enterprise Linux Server release (.+) \(',
55             'slackware' => '^Slackware (.+)$',
56             'pardus' => '^Pardus (.+)$',
57             'centos' => '^CentOS(?: Linux)? release (.+) \(',
58             'scientific' => '^Scientific Linux release (.+) \(',
59             'amazon' => 'Amazon Linux AMI release (.+)$',
60             );
61              
62             sub new {
63 1     1 0 3 my %self = (
64             'DISTRIB_ID' => '',
65             'DISTRIB_RELEASE' => '',
66             'DISTRIB_CODENAME' => '',
67             'DISTRIB_DESCRIPTION' => '',
68             'release_file' => '',
69             'pattern' => ''
70             );
71              
72 1         6 return bless \%self;
73             }
74              
75             sub distribution_name {
76 1   33 1 0 4 my $self = shift || new();
77 1         1 my $distro;
78 1 50       3 if ( $distro = $self->_get_lsb_info() ) {
79 1 50       10 return $distro if ($distro);
80             }
81              
82 0         0 foreach (qw(enterprise-release fedora-release)) {
83 0 0 0     0 if ( -f "$release_files_directory/$_"
84             && !-l "$release_files_directory/$_" )
85             {
86 0 0 0     0 if ( -f "$release_files_directory/$_"
87             && !-l "$release_files_directory/$_" )
88             {
89 0         0 $self->{'DISTRIB_ID'} = $release_files{$_};
90 0         0 $self->{'release_file'} = $_;
91 0         0 return $self->{'DISTRIB_ID'};
92             }
93             }
94             }
95              
96 0         0 foreach ( keys %release_files ) {
97 0 0 0     0 if ( -f "$release_files_directory/$_"
98             && !-l "$release_files_directory/$_" )
99             {
100 0 0 0     0 if ( -f "$release_files_directory/$_"
101             && !-l "$release_files_directory/$_" )
102             {
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 0         0 undef;
122             }
123              
124             sub distribution_version {
125 0   0 0 0 0 my $self = shift || new();
126 0         0 my $release;
127 0 0       0 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 1     1   1 my $self = shift;
139 1   50     3 my $field = shift || 'DISTRIB_ID';
140 1         1 my $tmp = $self->{'release_file'};
141 1 50       17 if ( -r "$release_files_directory/" . $standard_release_file ) {
142 1         1 $self->{'release_file'} = $standard_release_file;
143 1         2 $self->{'pattern'} = $field . '=(.+)';
144 1         1 my $info = $self->_get_file_info();
145 1 50       1 if ($info) {
146 1         10 $self->{$field} = $info;
147 1         2 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 1     1   1 my $self = shift;
157 1 50       333 open my $fh, '<', "$release_files_directory/" . $self->{'release_file'}
158             or die 'Cannot open file: '
159             . $release_files_directory . '/'
160             . $self->{'release_file'};
161 1         1 my $info = '';
162 1         1 local $_;
163 1         8 while (<$fh>) {
164 1         2 chomp $_;
165 1         18 ($info) = $_ =~ m/$self->{'pattern'}/;
166 1 50       10 return "\L$info" if $info;
167             }
168 0           undef;
169             }
170              
171             1;
172              
173             __END__