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

Last change on this file since 22 was 22, checked in by Bruno Cornec, 17 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
RevLine 
[22]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.