|
0 |
package Linux::Distribution;
|
|
1 |
|
|
2 |
use 5.006000;
|
|
3 |
use strict;
|
|
4 |
use warnings;
|
|
5 |
|
|
6 |
require Exporter;
|
|
7 |
|
|
8 |
our @ISA = qw(Exporter);
|
|
9 |
|
|
10 |
our @EXPORT_OK = qw( distribution_name distribution_version );
|
|
11 |
|
|
12 |
our $VERSION = '0.20';
|
|
13 |
|
|
14 |
our $release_files_directory='/etc';
|
|
15 |
our $standard_release_file = 'lsb-release';
|
|
16 |
|
|
17 |
our %release_files = (
|
|
18 |
'gentoo-release' => 'gentoo',
|
|
19 |
'fedora-release' => 'fedora',
|
|
20 |
'turbolinux-release' => 'turbolinux',
|
|
21 |
'mandrake-release' => 'mandrake',
|
|
22 |
'mandrakelinux-release' => 'mandrakelinux',
|
|
23 |
'debian_version' => 'debian',
|
|
24 |
'debian_release' => 'debian',
|
|
25 |
'SuSE-release' => 'suse',
|
|
26 |
'knoppix-version' => 'knoppix',
|
|
27 |
'yellowdog-release' => 'yellowdog',
|
|
28 |
'slackware-version' => 'slackware',
|
|
29 |
'slackware-release' => 'slackware',
|
|
30 |
'redflag-release' => 'redflag',
|
|
31 |
'redhat-release' => 'redhat',
|
|
32 |
'redhat_version' => 'redhat',
|
|
33 |
'conectiva-release' => 'conectiva',
|
|
34 |
'immunix-release' => 'immunix',
|
|
35 |
'tinysofa-release' => 'tinysofa',
|
|
36 |
'trustix-release' => 'trustix',
|
|
37 |
'adamantix_version' => 'adamantix',
|
|
38 |
'yoper-release' => 'yoper',
|
|
39 |
'arch-release' => 'arch',
|
|
40 |
'libranet_version' => 'libranet',
|
|
41 |
'va-release' => 'va-linux',
|
|
42 |
'pardus-release' => 'pardus',
|
|
43 |
);
|
|
44 |
|
|
45 |
our %version_match = (
|
|
46 |
'gentoo' => 'Gentoo Base System release (.*)',
|
|
47 |
'debian' => '(.+)',
|
|
48 |
'suse' => 'VERSION = (.*)',
|
|
49 |
'fedora' => 'Fedora Core release (\d+) \(',
|
|
50 |
'redflag' => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
|
|
51 |
'redhat' => 'Red Hat Linux release (.*) \(',
|
|
52 |
'slackware' => '^Slackware (.+)$',
|
|
53 |
'pardus' => '^Pardus (.+)$',
|
|
54 |
'centos' => '^CentOS release (.+)(?:\s\(Final\))',
|
|
55 |
);
|
|
56 |
|
|
57 |
|
|
58 |
if ($^O ne 'linux') {
|
|
59 |
# require Carp;
|
|
60 |
# Carp::croak('you are trying to use a linux specific module on a different OS');
|
|
61 |
}
|
|
62 |
|
|
63 |
sub new {
|
|
64 |
my %self = (
|
|
65 |
'DISTRIB_ID' => '',
|
|
66 |
'DISTRIB_RELEASE' => '',
|
|
67 |
'DISTRIB_CODENAME' => '',
|
|
68 |
'DISTRIB_DESCRIPTION' => '',
|
|
69 |
'release_file' => '',
|
|
70 |
'pattern' => ''
|
|
71 |
);
|
|
72 |
|
|
73 |
return bless \%self;
|
|
74 |
}
|
|
75 |
|
|
76 |
sub distribution_name {
|
|
77 |
my $self = shift || new();
|
|
78 |
my $distro;
|
|
79 |
if ($distro = $self->_get_lsb_info()){
|
|
80 |
return $distro if ($distro);
|
|
81 |
}
|
|
82 |
|
|
83 |
foreach ('fedora-release') {
|
|
84 |
if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){
|
|
85 |
if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){
|
|
86 |
$self->{'DISTRIB_ID'} = $release_files{$_};
|
|
87 |
$self->{'release_file'} = $_;
|
|
88 |
return $self->{'DISTRIB_ID'};
|
|
89 |
}
|
|
90 |
}
|
|
91 |
}
|
|
92 |
|
|
93 |
foreach (keys %release_files) {
|
|
94 |
if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){
|
|
95 |
if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){
|
|
96 |
if ( $release_files{$_} eq 'redhat' ) {
|
|
97 |
$self->{'pattern'} = $version_match{'centos'};
|
|
98 |
$self->{'release_file'}='redhat-release';
|
|
99 |
if ( $self->_get_file_info() ) {
|
|
100 |
$self->{'DISTRIB_ID'} = 'centos';
|
|
101 |
$self->{'release_file'} = $_;
|
|
102 |
return $self->{'DISTRIB_ID'};
|
|
103 |
} else {
|
|
104 |
$self->{'pattern'}='';
|
|
105 |
}
|
|
106 |
}
|
|
107 |
$self->{'release_file'} = $_;
|
|
108 |
$self->{'DISTRIB_ID'} = $release_files{$_};
|
|
109 |
return $self->{'DISTRIB_ID'};
|
|
110 |
}
|
|
111 |
}
|
|
112 |
}
|
|
113 |
undef
|
|
114 |
}
|
|
115 |
|
|
116 |
sub distribution_version {
|
|
117 |
my $self = shift || new();
|
|
118 |
my $release;
|
|
119 |
return $release if ($release = $self->_get_lsb_info('DISTRIB_RELEASE'));
|
|
120 |
if (! $self->{'DISTRIB_ID'}){
|
|
121 |
$self->distribution_name() or die 'No version because no distro.';
|
|
122 |
}
|
|
123 |
$self->{'pattern'} = $version_match{$self->{'DISTRIB_ID'}};
|
|
124 |
$release = $self->_get_file_info();
|
|
125 |
$self->{'DISTRIB_RELEASE'} = $release;
|
|
126 |
return $release;
|
|
127 |
}
|
|
128 |
|
|
129 |
sub _get_lsb_info {
|
|
130 |
my $self = shift;
|
|
131 |
my $field = shift || 'DISTRIB_ID';
|
|
132 |
my $tmp = $self->{'release_file'};
|
|
133 |
if ( -r "$release_files_directory/" . $standard_release_file ) {
|
|
134 |
$self->{'release_file'} = $standard_release_file;
|
|
135 |
$self->{'pattern'} = $field . '=(.+)';
|
|
136 |
my $info = $self->_get_file_info();
|
|
137 |
if ($info){
|
|
138 |
$self->{$field} = $info;
|
|
139 |
return $info
|
|
140 |
}
|
|
141 |
}
|
|
142 |
$self->{'release_file'} = $tmp;
|
|
143 |
$self->{'pattern'} = '';
|
|
144 |
undef;
|
|
145 |
}
|
|
146 |
|
|
147 |
sub _get_file_info {
|
|
148 |
my $self = shift;
|
|
149 |
open my $fh, '<', "$release_files_directory/" . $self->{'release_file'} or die 'Cannot open file: '.$release_files_directory.'/' . $self->{'release_file'};
|
|
150 |
my $info = '';
|
|
151 |
local $_;
|
|
152 |
while (<$fh>){
|
|
153 |
chomp $_;
|
|
154 |
($info) = $_ =~ m/$self->{'pattern'}/;
|
|
155 |
return "\L$info" if $info;
|
|
156 |
}
|
|
157 |
undef;
|
|
158 |
}
|
|
159 |
|
|
160 |
1;
|
|
161 |
__END__
|
|
162 |
|
|
163 |
|
|
164 |
=head1 NAME
|
|
165 |
|
|
166 |
Linux::Distribution - Perl extension to detect on which Linux distribution we are running.
|
|
167 |
|
|
168 |
=head1 SYNOPSIS
|
|
169 |
|
|
170 |
use Linux::Distribution qw(distribution_name distribution_version);
|
|
171 |
|
|
172 |
if(my $distro = distribution_name) {
|
|
173 |
my $version = distribution_version();
|
|
174 |
print "you are running $distro, version $version\n";
|
|
175 |
} else {
|
|
176 |
print "distribution unknown\n";
|
|
177 |
}
|
|
178 |
|
|
179 |
Or else do it OO:
|
|
180 |
|
|
181 |
use Linux::Distribution qw(distribution_name distribution_version);
|
|
182 |
|
|
183 |
my $linux = Linux::Distribution->new;
|
|
184 |
if(my $distro = $linux->distribution_name()) {
|
|
185 |
my $version = $linux->distribution_version();
|
|
186 |
print "you are running $distro, version $version\n";
|
|
187 |
} else {
|
|
188 |
print "distribution unknown\n";
|
|
189 |
}
|
|
190 |
|
|
191 |
=head1 DESCRIPTION
|
|
192 |
|
|
193 |
This is a simple module that tries to guess on what linux distribution we are running by looking for release's files in /etc. It now looks for 'lsb-release' first as that should be the most correct and adds ubuntu support. Secondly, it will look for the distro specific files.
|
|
194 |
|
|
195 |
It currently recognizes slackware, debian, suse, fedora, redhat, turbolinux, yellowdog, knoppix, mandrake, conectiva, immunix, tinysofa, va-linux, trustix, adamantix, yoper, arch-linux, libranet, gentoo, ubuntu and redflag.
|
|
196 |
|
|
197 |
It has function to get the version for debian, suse, redhat, gentoo, slackware, redflag and ubuntu(lsb). People running unsupported distro's are greatly encouraged to submit patches :-)
|
|
198 |
|
|
199 |
=head2 EXPORT
|
|
200 |
|
|
201 |
None by default.
|
|
202 |
|
|
203 |
=head1 TODO
|
|
204 |
|
|
205 |
Add the capability of recognize the version of the distribution for all recognized distributions.
|
|
206 |
|
|
207 |
=head1 AUTHORS
|
|
208 |
|
|
209 |
Alexandr Ciornii E<lt>alexchorny@gmail.comE<gt>, L<http://chorny.net>
|
|
210 |
Alberto Re, E<lt>alberto@accidia.netE<gt>
|
|
211 |
Judith Lebzelter, E<lt>judith@osdl.orgE<gt>
|
|
212 |
|
|
213 |
=head1 COPYRIGHT AND LICENSE
|
|
214 |
|
|
215 |
This library is free software; you can redistribute it and/or modify
|
|
216 |
it under the same terms as Perl itself, either Perl version 5.8.5 or,
|
|
217 |
at your option, any later version of Perl 5 you may have available.
|
|
218 |
|
|
219 |
=cut
|
|
220 |
|