[22] | 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 |
|
---|