1 | package LinuxDistribution;
|
---|
2 |
|
---|
3 | use 5.006000;
|
---|
4 | use strict;
|
---|
5 | use warnings;
|
---|
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.14';
|
---|
14 |
|
---|
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 | );
|
---|
43 |
|
---|
44 | our %version_match = (
|
---|
45 | 'gentoo' => 'Gentoo Base System version (.*)',
|
---|
46 | 'debian' => '(.+)',
|
---|
47 | 'suse' => 'VERSION = (.*)',
|
---|
48 | 'fedora' => 'Fedora Core release (\d+) \(',
|
---|
49 | 'redflag' => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
|
---|
50 | 'redhat' => 'Red Hat Linux release (.*) \(',
|
---|
51 | 'slackware' => '^Slackware (.+)$'
|
---|
52 | );
|
---|
53 |
|
---|
54 |
|
---|
55 | if ($^O ne 'linux') {
|
---|
56 | require Carp;
|
---|
57 | Carp::croak 'you are trying to use a linux specific module on a different OS';
|
---|
58 | }
|
---|
59 |
|
---|
60 | sub new {
|
---|
61 | my %self = (
|
---|
62 | 'DISTRIB_ID' => '',
|
---|
63 | 'DISTRIB_RELEASE' => '',
|
---|
64 | 'DISTRIB_CODENAME' => '',
|
---|
65 | 'DISTRIB_DESCRIPTION' => '',
|
---|
66 | 'release_file' => '',
|
---|
67 | 'pattern' => ''
|
---|
68 | );
|
---|
69 |
|
---|
70 | return bless \%self;
|
---|
71 | }
|
---|
72 |
|
---|
73 | sub distribution_name {
|
---|
74 | my $self = shift || new();
|
---|
75 | my $distro;
|
---|
76 | if ($distro = $self->_get_lsb_info()){
|
---|
77 | return $distro if ($distro);
|
---|
78 | }
|
---|
79 | foreach (keys %release_files) {
|
---|
80 | if (-f "/etc/$_" && !-l "/etc/$_"){
|
---|
81 | if (-f "/etc/$_" && !-l "/etc/$_"){
|
---|
82 | $self->{'DISTRIB_ID'} = $release_files{$_};
|
---|
83 | $self->{'release_file'} = $_;
|
---|
84 | return $self->{'DISTRIB_ID'};
|
---|
85 | }
|
---|
86 | }
|
---|
87 | }
|
---|
88 | undef
|
---|
89 | }
|
---|
90 |
|
---|
91 | sub distribution_version {
|
---|
92 | my $self = shift || new();
|
---|
93 | my $release;
|
---|
94 | return $release if ($release = $self->_get_lsb_info('DISTRIB_RELEASE'));
|
---|
95 | if (! $self->{'DISTRIB_ID'}){
|
---|
96 | $self->distribution_name() or die 'No version because no distro.';
|
---|
97 | }
|
---|
98 | $self->{'pattern'} = $version_match{$self->{'DISTRIB_ID'}};
|
---|
99 | $release = $self->_get_file_info();
|
---|
100 | $self->{'DISTRIB_RELEASE'} = $release;
|
---|
101 | return $release;
|
---|
102 | }
|
---|
103 |
|
---|
104 | sub _get_lsb_info {
|
---|
105 | my $self = shift;
|
---|
106 | my $field = shift || 'DISTRIB_ID';
|
---|
107 | my $tmp = $self->{'release_file'};
|
---|
108 | if ( -r '/etc/' . $standard_release_file ) {
|
---|
109 | $self->{'release_file'} = $standard_release_file;
|
---|
110 | $self->{'pattern'} = $field . '=(.+)';
|
---|
111 | my $info = $self->_get_file_info();
|
---|
112 | if ($info){
|
---|
113 | $self->{$field} = $info;
|
---|
114 | return $info
|
---|
115 | }
|
---|
116 | }
|
---|
117 | $self->{'release_file'} = $tmp;
|
---|
118 | $self->{'pattern'} = '';
|
---|
119 | undef;
|
---|
120 | }
|
---|
121 |
|
---|
122 | sub _get_file_info {
|
---|
123 | my $self = shift;
|
---|
124 | open FH, '/etc/' . $self->{'release_file'} or die 'Cannot open file: /etc/' . $self->{'release_file'};
|
---|
125 | my $info = '';
|
---|
126 | while (<FH>){
|
---|
127 | chomp $_;
|
---|
128 | ($info) = $_ =~ m/$self->{'pattern'}/;
|
---|
129 | return "\L$info" if $info;
|
---|
130 | }
|
---|
131 | undef;
|
---|
132 | }
|
---|
133 |
|
---|
134 | 1;
|
---|
135 | __END__
|
---|
136 |
|
---|
137 |
|
---|
138 | =head1 NAME
|
---|
139 |
|
---|
140 | Linux::Distribution - Perl extension to guess on which Linux distribution we are running.
|
---|
141 |
|
---|
142 | =head1 SYNOPSIS
|
---|
143 |
|
---|
144 | use Linux::Distribution qw(distribution_name distribution_version);
|
---|
145 |
|
---|
146 | if(my $distro = distribution_name) {
|
---|
147 | my $version = distribution_version();
|
---|
148 | print "you are running $distro, version $version\n";
|
---|
149 | } else {
|
---|
150 | print "distribution unknown\n";
|
---|
151 | }
|
---|
152 |
|
---|
153 | Or else do it OO:
|
---|
154 |
|
---|
155 | use Linux::Distribution qw(distribution_name distribution_version);
|
---|
156 |
|
---|
157 | $linux = new Linux::Distribution;
|
---|
158 | if(my $distro = $linux->distribution_name()) {
|
---|
159 | my $version = $linux->distribution_version();
|
---|
160 | print "you are running $distro, version $version\n";
|
---|
161 | } else {
|
---|
162 | print "distribution unknown\n";
|
---|
163 | }
|
---|
164 |
|
---|
165 | =head1 DESCRIPTION
|
---|
166 |
|
---|
167 | 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.
|
---|
168 |
|
---|
169 | 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.
|
---|
170 |
|
---|
171 | 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 :-)
|
---|
172 |
|
---|
173 | =head2 EXPORT
|
---|
174 |
|
---|
175 | None by default.
|
---|
176 |
|
---|
177 | =head1 TODO
|
---|
178 |
|
---|
179 | Add the capability of recognize the version of the distribution for all recognized distributions.
|
---|
180 |
|
---|
181 | =head1 AUTHORS
|
---|
182 |
|
---|
183 | Alberto Re, E<lt>alberto@accidia.netE<gt>
|
---|
184 | Judith Lebzelter, E<lt>judith@osdl.orgE<gt>
|
---|
185 |
|
---|
186 | =head1 COPYRIGHT AND LICENSE
|
---|
187 |
|
---|
188 | This library is free software; you can redistribute it and/or modify
|
---|
189 | it under the same terms as Perl itself, either Perl version 5.8.5 or,
|
---|
190 | at your option, any later version of Perl 5 you may have available.
|
---|
191 |
|
---|
192 | =cut
|
---|
193 |
|
---|