source: devel/pb/lib/LinuxDistribution.pm @ 22

Last change on this file since 22 was 22, checked in by bruno, 12 years ago

Begin to work on pkg2build
Cope the module Linux::Distribution in the project as it's not packages for my distro
Will make delivery much easier.

File size: 5.7 KB
Line 
1package LinuxDistribution;
2
3use 5.006000;
4use strict;
5use warnings;
6
7require Exporter;
8
9our @ISA = qw(Exporter);
10
11our @EXPORT_OK = qw( distribution_name distribution_version );
12
13our $VERSION = '0.14';
14
15our $standard_release_file = 'lsb-release';
16
17our %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
44our %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
55if ($^O ne 'linux') {
56    require Carp;
57    Carp::croak 'you are trying to use a linux specific module on a different OS';
58}
59
60sub 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
73sub 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
91sub 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
104sub _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
122sub _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
1341;
135__END__
136
137
138=head1 NAME
139
140Linux::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
167This 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
169It 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
171It 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
175None by default.
176
177=head1 TODO
178
179Add the capability of recognize the version of the distribution for all recognized distributions.
180
181=head1 AUTHORS
182
183Alberto Re, E<lt>alberto@accidia.netE<gt>
184Judith Lebzelter, E<lt>judith@osdl.orgE<gt>
185
186=head1 COPYRIGHT AND LICENSE
187
188This library is free software; you can redistribute it and/or modify
189it under the same terms as Perl itself, either Perl version 5.8.5 or,
190at your option, any later version of Perl 5 you may have available.
191
192=cut
193
Note: See TracBrowser for help on using the repository browser.