| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Linux::Distribution; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 2159 | use 5.006000; | 
|  | 1 |  |  |  |  | 4 |  | 
|  | 1 |  |  |  |  | 41 |  | 
| 4 | 1 |  |  | 1 |  | 5 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 33 |  | 
| 5 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 1154 |  | 
| 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.21'; | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | our $release_files_directory='/etc'; | 
| 16 |  |  |  |  |  |  | our $standard_release_file = 'lsb-release'; | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | our %release_files = ( | 
| 19 |  |  |  |  |  |  | 'gentoo-release'        => 'gentoo', | 
| 20 |  |  |  |  |  |  | 'fedora-release'        => 'fedora', | 
| 21 |  |  |  |  |  |  | 'centos-release'        => 'centos', | 
| 22 |  |  |  |  |  |  | 'enterprise-release'    => 'oracle enterprise linux', | 
| 23 |  |  |  |  |  |  | 'turbolinux-release'    => 'turbolinux', | 
| 24 |  |  |  |  |  |  | 'mandrake-release'      => 'mandrake', | 
| 25 |  |  |  |  |  |  | 'mandrakelinux-release' => 'mandrakelinux', | 
| 26 |  |  |  |  |  |  | 'debian_version'        => 'debian', | 
| 27 |  |  |  |  |  |  | 'debian_release'        => 'debian', | 
| 28 |  |  |  |  |  |  | 'SuSE-release'          => 'suse', | 
| 29 |  |  |  |  |  |  | 'knoppix-version'       => 'knoppix', | 
| 30 |  |  |  |  |  |  | 'yellowdog-release'     => 'yellowdog', | 
| 31 |  |  |  |  |  |  | 'slackware-version'     => 'slackware', | 
| 32 |  |  |  |  |  |  | 'slackware-release'     => 'slackware', | 
| 33 |  |  |  |  |  |  | 'redflag-release'       => 'redflag', | 
| 34 |  |  |  |  |  |  | 'redhat-release'        => 'redhat', | 
| 35 |  |  |  |  |  |  | 'redhat_version'        => 'redhat', | 
| 36 |  |  |  |  |  |  | 'conectiva-release'     => 'conectiva', | 
| 37 |  |  |  |  |  |  | 'immunix-release'       => 'immunix', | 
| 38 |  |  |  |  |  |  | 'tinysofa-release'      => 'tinysofa', | 
| 39 |  |  |  |  |  |  | 'trustix-release'       => 'trustix', | 
| 40 |  |  |  |  |  |  | 'adamantix_version'     => 'adamantix', | 
| 41 |  |  |  |  |  |  | 'yoper-release'         => 'yoper', | 
| 42 |  |  |  |  |  |  | 'arch-release'          => 'arch', | 
| 43 |  |  |  |  |  |  | 'libranet_version'      => 'libranet', | 
| 44 |  |  |  |  |  |  | 'va-release'            => 'va-linux', | 
| 45 |  |  |  |  |  |  | 'pardus-release'        => 'pardus', | 
| 46 |  |  |  |  |  |  | 'system-release'        => 'amazon', | 
| 47 |  |  |  |  |  |  | ); | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | our %version_match = ( | 
| 50 |  |  |  |  |  |  | 'gentoo'                => 'Gentoo Base System release (.*)', | 
| 51 |  |  |  |  |  |  | 'debian'                => '(.+)', | 
| 52 |  |  |  |  |  |  | 'suse'                  => 'VERSION = (.*)', | 
| 53 |  |  |  |  |  |  | 'fedora'                => 'Fedora(?: Core)? release (\d+) \(', | 
| 54 |  |  |  |  |  |  | 'redflag'               => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)', | 
| 55 |  |  |  |  |  |  | 'redhat'                => 'Red Hat(?: Enterprise)? Linux(?: Server)? release (.*) \(', | 
| 56 |  |  |  |  |  |  | 'oracle enterprise linux' => 'Enterprise Linux Server release (.+) \(', | 
| 57 |  |  |  |  |  |  | 'slackware'             => '^Slackware (.+)$', | 
| 58 |  |  |  |  |  |  | 'pardus'                => '^Pardus (.+)$', | 
| 59 |  |  |  |  |  |  | 'centos'                => '^CentOS(?: Linux)? release (.+)(?:\s\(Final\))', | 
| 60 |  |  |  |  |  |  | 'scientific'            => '^Scientific Linux release (.+) \(', | 
| 61 |  |  |  |  |  |  | 'amazon'                => 'Amazon Linux AMI release (.+)$', | 
| 62 |  |  |  |  |  |  | ); | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | if ($^O ne 'linux') { | 
| 66 |  |  |  |  |  |  | #	require Carp; | 
| 67 |  |  |  |  |  |  | #	Carp::croak('you are trying to use a linux specific module on a different OS'); | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | sub new { | 
| 71 | 1 |  |  | 1 | 0 | 11 | my %self = ( | 
| 72 |  |  |  |  |  |  | 'DISTRIB_ID'          => '', | 
| 73 |  |  |  |  |  |  | 'DISTRIB_RELEASE'     => '', | 
| 74 |  |  |  |  |  |  | 'DISTRIB_CODENAME'    => '', | 
| 75 |  |  |  |  |  |  | 'DISTRIB_DESCRIPTION' => '', | 
| 76 |  |  |  |  |  |  | 'release_file'        => '', | 
| 77 |  |  |  |  |  |  | 'pattern'             => '' | 
| 78 |  |  |  |  |  |  | ); | 
| 79 |  |  |  |  |  |  |  | 
| 80 | 1 |  |  |  |  | 4 | return bless \%self; | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | sub distribution_name { | 
| 84 | 1 |  | 33 | 1 | 0 | 10 | my $self = shift || new(); | 
| 85 | 1 |  |  |  |  | 2 | my $distro; | 
| 86 | 1 | 50 |  |  |  | 6 | if ($distro = $self->_get_lsb_info()){ | 
| 87 | 1 | 50 |  |  |  | 7 | return $distro if ($distro); | 
| 88 |  |  |  |  |  |  | } | 
| 89 |  |  |  |  |  |  |  | 
| 90 | 0 |  |  |  |  | 0 | foreach (qw(enterprise-release fedora-release)) { | 
| 91 | 0 | 0 | 0 |  |  | 0 | if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){ | 
| 92 | 0 | 0 | 0 |  |  | 0 | if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){ | 
| 93 | 0 |  |  |  |  | 0 | $self->{'DISTRIB_ID'} = $release_files{$_}; | 
| 94 | 0 |  |  |  |  | 0 | $self->{'release_file'} = $_; | 
| 95 | 0 |  |  |  |  | 0 | return $self->{'DISTRIB_ID'}; | 
| 96 |  |  |  |  |  |  | } | 
| 97 |  |  |  |  |  |  | } | 
| 98 |  |  |  |  |  |  | } | 
| 99 |  |  |  |  |  |  |  | 
| 100 | 0 |  |  |  |  | 0 | foreach (keys %release_files) { | 
| 101 | 0 | 0 | 0 |  |  | 0 | if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){ | 
| 102 | 0 | 0 | 0 |  |  | 0 | if (-f "$release_files_directory/$_" && !-l "$release_files_directory/$_"){ | 
| 103 | 0 | 0 |  |  |  | 0 | if ( $release_files{$_} eq 'redhat' ) { | 
| 104 | 0 |  |  |  |  | 0 | foreach my $rhel_deriv ('centos','scientific',) { | 
| 105 | 0 |  |  |  |  | 0 | $self->{'pattern'} = $version_match{$rhel_deriv}; | 
| 106 | 0 |  |  |  |  | 0 | $self->{'release_file'}='redhat-release'; | 
| 107 | 0 | 0 |  |  |  | 0 | if ( $self->_get_file_info() ) { | 
| 108 | 0 |  |  |  |  | 0 | $self->{'DISTRIB_ID'} = $rhel_deriv; | 
| 109 | 0 |  |  |  |  | 0 | $self->{'release_file'} = $_; | 
| 110 | 0 |  |  |  |  | 0 | return $self->{'DISTRIB_ID'}; | 
| 111 |  |  |  |  |  |  | } | 
| 112 |  |  |  |  |  |  | } | 
| 113 | 0 |  |  |  |  | 0 | $self->{'pattern'}=''; | 
| 114 |  |  |  |  |  |  | } | 
| 115 | 0 |  |  |  |  | 0 | $self->{'release_file'} = $_; | 
| 116 | 0 |  |  |  |  | 0 | $self->{'DISTRIB_ID'} = $release_files{$_}; | 
| 117 | 0 |  |  |  |  | 0 | return $self->{'DISTRIB_ID'}; | 
| 118 |  |  |  |  |  |  | } | 
| 119 |  |  |  |  |  |  | } | 
| 120 |  |  |  |  |  |  | } | 
| 121 |  |  |  |  |  |  | undef | 
| 122 | 0 |  |  |  |  | 0 | } | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | sub distribution_version { | 
| 125 | 1 |  | 33 | 1 | 0 | 5 | my $self = shift || new(); | 
| 126 | 1 |  |  |  |  | 1 | my $release; | 
| 127 | 1 | 50 |  |  |  | 2 | return $release if ($release = $self->_get_lsb_info('DISTRIB_RELEASE')); | 
| 128 | 0 | 0 |  |  |  | 0 | if (! $self->{'DISTRIB_ID'}){ | 
| 129 | 0 | 0 |  |  |  | 0 | $self->distribution_name() or die 'No version because no distro.'; | 
| 130 |  |  |  |  |  |  | } | 
| 131 | 0 |  |  |  |  | 0 | $self->{'pattern'} = $version_match{$self->{'DISTRIB_ID'}}; | 
| 132 | 0 |  |  |  |  | 0 | $release = $self->_get_file_info(); | 
| 133 | 0 |  |  |  |  | 0 | $self->{'DISTRIB_RELEASE'} = $release; | 
| 134 | 0 |  |  |  |  | 0 | return $release; | 
| 135 |  |  |  |  |  |  | } | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | sub _get_lsb_info { | 
| 138 | 2 |  |  | 2 |  | 4 | my $self = shift; | 
| 139 | 2 |  | 100 |  |  | 10 | my $field = shift || 'DISTRIB_ID'; | 
| 140 | 2 |  |  |  |  | 4 | my $tmp = $self->{'release_file'}; | 
| 141 | 2 | 50 |  |  |  | 50 | if ( -r "$release_files_directory/" . $standard_release_file ) { | 
| 142 | 2 |  |  |  |  | 3 | $self->{'release_file'} = $standard_release_file; | 
| 143 | 2 |  |  |  |  | 5 | $self->{'pattern'} = $field . '=(.+)'; | 
| 144 | 2 |  |  |  |  | 4 | my $info = $self->_get_file_info(); | 
| 145 | 2 | 50 |  |  |  | 7 | if ($info){ | 
| 146 | 2 |  |  |  |  | 3 | $self->{$field} = $info; | 
| 147 | 2 |  |  |  |  | 11 | return $info | 
| 148 |  |  |  |  |  |  | } | 
| 149 |  |  |  |  |  |  | } | 
| 150 | 0 |  |  |  |  | 0 | $self->{'release_file'} = $tmp; | 
| 151 | 0 |  |  |  |  | 0 | $self->{'pattern'} = ''; | 
| 152 | 0 |  |  |  |  | 0 | undef; | 
| 153 |  |  |  |  |  |  | } | 
| 154 |  |  |  |  |  |  |  | 
| 155 |  |  |  |  |  |  | sub _get_file_info { | 
| 156 | 2 |  |  | 2 |  | 3 | my $self = shift; | 
| 157 | 2 | 50 |  |  |  | 77 | open my $fh, '<', "$release_files_directory/" . $self->{'release_file'} or die 'Cannot open file: '.$release_files_directory.'/' . $self->{'release_file'}; | 
| 158 | 2 |  |  |  |  | 3 | my $info = ''; | 
| 159 | 2 |  |  |  |  | 2 | local $_; | 
| 160 | 2 |  |  |  |  | 31 | while (<$fh>){ | 
| 161 | 3 |  |  |  |  | 5 | chomp $_; | 
| 162 | 3 |  |  |  |  | 630 | ($info) = $_ =~ m/$self->{'pattern'}/; | 
| 163 | 3 | 100 |  |  |  | 41 | return "\L$info" if $info; | 
| 164 |  |  |  |  |  |  | } | 
| 165 | 0 |  |  |  |  |  | undef; | 
| 166 |  |  |  |  |  |  | } | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | 1; | 
| 169 |  |  |  |  |  |  | __END__ |