File Coverage

blib/lib/Devel/Platform/Info/Linux.pm
Criterion Covered Total %
statement 28 58 48.2
branch 5 26 19.2
condition 0 3 0.0
subroutine 5 6 83.3
pod 2 2 100.0
total 40 95 42.1


line stmt bran cond sub pod time code
1             package Devel::Platform::Info::Linux;
2              
3 5     5   6767 use strict;
  5         7  
  5         126  
4 5     5   18 use warnings;
  5         5  
  5         124  
5              
6 5     5   15 use vars qw($VERSION);
  5         6  
  5         6667  
7             $VERSION = '0.16';
8              
9             =encoding utf8
10              
11             =head1 NAME
12              
13             Devel::Platform::Info::Linux - Retrieve Linux platform metadata
14              
15             =cut
16              
17             #----------------------------------------------------------------------------
18              
19             my %commands = (
20             '_issue1' => 'cat /etc/issue',
21             '_issue2' => 'cat /etc/.issue',
22             '_uname' => 'uname -a',
23             '_lsb' => 'lsb_release -a',
24             'kname' => 'uname -s',
25             'kvers' => 'uname -r',
26             'osname' => 'uname -o',
27             'archname' => 'uname -m',
28             );
29              
30             my %default = ();
31              
32             # http://en.wikipedia.org/wiki/Arch_Linux#Versions
33             my %archlinux = (
34             '0.1' => 'Homer',
35             '0.2' => 'Vega',
36             '0.3' => 'Firefly',
37             '0.4' => 'Dragon',
38             '0.5' => 'Nova',
39             '0.6' => 'Widget',
40             '0.7' => 'Wombat',
41             '0.8' => 'Voodoo',
42             '2007.05' => 'Duke',
43             '2007.08' => "Don't Panic",
44             '2008.06' => 'Overlord',
45             '2009.02' => '2009.02',
46             '2009.08' => '2009.08',
47             '2010.05' => '2010.05',
48             '2011.08.19' => '2011.08.19',
49             );
50              
51             # previously CrunchBang Linux hasn't normally used codenames, however from
52             # version 10 they are using Debian releases as a base, and thus are using
53             # Muppet Show characters to compliment the Toy Story characters as used by
54             # Debian.
55              
56             my %crunch = (
57             '8.04.02' => 'Back in Black',
58             '10' => 'Statler',
59             '11' => 'Waldorf',
60             );
61              
62             # http://en.wikipedia.org/wiki/Debian#Release_history
63             my %debian = (
64             '1.1' => 'buzz',
65             '1.2' => 'rex',
66             '1.3' => 'bo',
67             '2.0' => 'hamm',
68             '2.1' => 'slink',
69             '2.2' => 'potato',
70             '3.0' => 'woody',
71             '3.1' => 'sarge',
72             '4.0' => 'etch',
73             '4.1' => 'etch',
74             '4.2' => 'etch',
75             '4.3' => 'etch',
76             '4.4' => 'etch',
77             '4.5' => 'etch',
78             '4.6' => 'etch',
79             '4.7' => 'etch',
80             '4.8' => 'etch',
81             '4.9' => 'etch',
82             '5.0' => 'lenny',
83             '5.1' => 'lenny',
84             '5.2' => 'lenny',
85             '5.3' => 'lenny',
86             '5.4' => 'lenny',
87             '5.5' => 'lenny',
88             '5.6' => 'lenny',
89             '5.7' => 'lenny',
90             '5.8' => 'lenny',
91             '5.9' => 'lenny',
92             '5.10' => 'lenny',
93             '6.0' => 'squeeze',
94             '6.1' => 'squeeze',
95             '6.2' => 'squeeze',
96             '6.3' => 'squeeze',
97             '6.4' => 'squeeze',
98             '6.5' => 'squeeze',
99             '6.6' => 'squeeze',
100             '6.7' => 'squeeze',
101             '6.8' => 'squeeze',
102             '6.9' => 'squeeze',
103             '6.10' => 'squeeze',
104             '7.0' => 'wheezy',
105             '7.1' => 'wheezy',
106             '7.2' => 'wheezy',
107             '7.3' => 'wheezy',
108             '7.4' => 'wheezy',
109             '7.5' => 'wheezy',
110             '7.6' => 'wheezy',
111             '7.7' => 'wheezy',
112             '7.8' => 'wheezy',
113             '7.9' => 'wheezy',
114             '7.10' => 'wheezy',
115             '8.0' => 'jessie',
116             '8.1' => 'jessie',
117             '8.2' => 'jessie',
118             '8.3' => 'jessie',
119             '8.4' => 'jessie',
120             '9.0' => 'stretch',
121             '10.0' => 'buster',
122             );
123              
124             # Fedora naming scheme is no longer used:
125             # https://lists.fedoraproject.org/pipermail/advisory-board/2013-October/012209.html
126             # "The Fedora Board is terminating Release Names as they are currently
127             # fashioned following Fedora 20."
128              
129             # http://en.wikipedia.org/wiki/Fedora_%28operating_system%29#Version_history
130             my %fedora = (
131             '1' => 'Yarrow',
132             '2' => 'Tettnang',
133             '3' => 'Heidelberg',
134             '4' => 'Stentz',
135             '5' => 'Bordeaux',
136             '6' => 'Zod',
137             '7' => 'Moonshine',
138             '8' => 'Werewolf',
139             '9' => 'Sulphur',
140             '10' => 'Cambridge',
141             '11' => 'Leonidas',
142             '12' => 'Constantine',
143             '13' => 'Goddard',
144             '14' => 'Laughlin',
145             '15' => 'Lovelock',
146             '16' => 'Verne',
147             '17' => 'Beefy Miracle',
148             '18' => 'Spherical Cow',
149             '19' => q[Schrödinger's Cat],
150             '20' => 'Heisenbug',
151             );
152              
153             # http://en.wikipedia.org/wiki/Mandriva_Linux#Versions
154             my %mandriva = (
155             '5.1' => 'Venice',
156             '5.2' => 'Leeloo',
157             '5.3' => 'Festen',
158             '6.0' => 'Venus',
159             '6.1' => 'Helios',
160             '7.0' => 'Air',
161             '7.1' => 'Helium',
162             '7.2' => 'Odyssey (called Ulysses during beta)',
163             '8.0' => 'Traktopel',
164             '8.1' => 'Vitamin',
165             '8.2' => 'Bluebird',
166             '9.0' => 'Dolphin',
167             '9.1' => 'Bamboo',
168             '9.2' => 'FiveStar',
169             '10.0' => 'Community and Official',
170             '10.1' => 'Community',
171             '10.1' => 'Official',
172             '10.2' => 'Limited Edition 2005',
173             '2006.0' => 'Mandriva Linux 2006',
174             '2007' => 'Mandriva Linux 2007',
175             '2007.1' => 'Mandriva Linux 2007 Spring',
176             '2008.0' => 'Mandriva Linux 2008',
177             '2008.1' => 'Mandriva Linux 2008 Spring',
178             '2009.0' => 'Mandriva Linux 2009',
179             '2009.1' => 'Mandriva Linux 2009 Spring',
180             '2010.0' => 'Mandriva Linux 2010 (Adélie)',
181             '2010.1' => 'Mandriva Linux 2010 Spring',
182             '2010.2' => 'Mandriva Linux 2010.2',
183             '2011.0' => 'Hydrogen',
184             );
185              
186             # http://en.wikipedia.org/wiki/Red_Hat_Linux#Version_history
187             # http://fedoraproject.org/wiki/History_of_Red_Hat_Linux
188             my %redhat = (
189             '0.8' => 'Preview',
190             '0.9' => 'Halloween',
191             '1.0' => q{Mother's Day},
192             '1.1' => q{Mother's Day+0.1},
193             '2.0' => '',
194             '2.1' => '',
195             '3.0.3' => 'Picasso',
196             '3.95' => 'Rembrandt',
197             '4.0' => 'Colgate',
198             '4.1' => 'Vanderbilt',
199             '4.2' => 'Biltmore',
200             '4.95' => 'Thunderbird',
201             '4.96' => 'Mustang',
202             '5.0' => 'Hurricane',
203             '5.1' => 'Manhattan',
204             '5.2' => 'Apollo',
205             '5.9' => 'Starbuck',
206             '6.0' => 'Hedwig',
207             '6.0.95' => 'Lorax',
208             '6.1' => 'Cartman',
209             '6.1.95' => 'Piglet',
210             '6.2' => 'Zoot',
211             '6.2.98' => 'Pinstripe',
212             '7' => 'Guinness',
213             '7.0.90' => 'Fisher',
214             '7.0.91' => 'Wolverine',
215             '7.1' => 'Seawolf',
216             '7.1.92' => 'Roswell',
217             '7.2' => 'Enigma',
218             '7.2.92' => 'Skipjack',
219             '7.3' => 'Valhalla',
220             '7.3.92' => 'Limbo',
221             '7.3.93' => 'Limbo',
222             '7.3.94' => 'Null',
223             '8.0' => 'Psyche',
224             '8.0.93' => 'Phoebe',
225             '9' => 'Shrike',
226             '9.0.93' => 'Severn',
227             );
228              
229             # http://en.wikipedia.org/wiki/Red_Hat_Enterprise_Linux#Version_history
230             my %rhel = (
231             '2.1 AS' => 'Pensacola',
232             '2.1' => 'Pensacola',
233             '2.1.1' => 'Pensacola',
234             '2.1.2' => 'Pensacola',
235             '2.1.3' => 'Pensacola',
236             '2.1.4' => 'Pensacola',
237             '2.1.5' => 'Pensacola',
238             '2.1.6' => 'Pensacola',
239             '2.1.7' => 'Pensacola',
240             '2.1 ES' => 'Panama',
241             '3' => 'Taroon',
242             '3.0' => 'Taroon',
243             '3.1' => 'Taroon',
244             '3.2' => 'Taroon',
245             '3.3' => 'Taroon',
246             '3.4' => 'Taroon',
247             '3.5' => 'Taroon',
248             '3.6' => 'Taroon',
249             '3.7' => 'Taroon',
250             '3.8' => 'Taroon',
251             '3.9' => 'Taroon',
252             '4' => 'Nahant',
253             '4.1' => 'Nahant',
254             '4.2' => 'Nahant',
255             '4.3' => 'Nahant',
256             '4.4' => 'Nahant',
257             '4.5' => 'Nahant',
258             '4.6' => 'Nahant',
259             '4.7' => 'Nahant',
260             '4.8' => 'Nahant',
261             '4.9' => 'Nahant',
262             '5' => 'Tikanga',
263             '5.1' => 'Tikanga',
264             '5.2' => 'Tikanga',
265             '5.3' => 'Tikanga',
266             '5.4' => 'Tikanga',
267             '5.5' => 'Tikanga',
268             '5.6' => 'Tikanga',
269             '5.7' => 'Tikanga',
270             '5.8' => 'Tikanga',
271             '6' => 'Santiago',
272             '6.1' => 'Santiago',
273             '6.2' => 'Santiago',
274             '6.3' => 'Santiago',
275             '6.4' => 'Santiago',
276             '6.5' => 'Santiago',
277             '7' => 'Maipo',
278             );
279              
280             # http://en.wikipedia.org/wiki/Scientific_Linux
281             my %scientific = (
282             '3.0.1' => 'Feynman',
283             '3.0.2' => 'Feynman',
284             '3.0.3' => 'Feynman',
285             '3.0.4' => 'Feynman',
286             '3.0.5' => 'Feynman',
287             '3.0.6' => 'Feynman',
288             '3.0.7' => 'Feynman',
289             '3.0.8' => 'Feynman',
290             '3.0.9' => 'Legacy',
291             '4.0' => 'Beryllium',
292             '4.1' => 'Beryllium',
293             '4.2' => 'Beryllium',
294             '4.3' => 'Beryllium',
295             '4.4' => 'Beryllium',
296             '4.5' => 'Beryllium',
297             '4.6' => 'Beryllium',
298             '4.7' => 'Beryllium',
299             '4.8' => 'Beryllium',
300             '4.9' => 'Beryllium',
301             '5.0' => 'Boron',
302             '5.1' => 'Boron',
303             '5.2' => 'Boron',
304             '5.3' => 'Boron',
305             '5.4' => 'Boron',
306             '5.5' => 'Boron',
307             '5.6' => 'Boron',
308             '5.7' => 'Boron',
309             '5.8' => 'Boron',
310             '5.9' => 'Boron',
311             '6.0' => 'Carbon',
312             '6.1' => 'Carbon',
313             '6.2' => 'Carbon',
314             '6.3' => 'Carbon',
315             '6.4' => 'Carbon',
316             '6.5' => 'Carbon',
317             '6.6' => 'Carbon',
318             '6.7' => 'Carbon',
319             '6.8' => 'Carbon',
320             '6.9' => 'Carbon',
321             '6.10' => 'Carbon',
322             '6.11' => 'Carbon',
323             '7.0' => 'Nitrogen',
324             '7.1' => 'Nitrogen',
325             '7.2' => 'Nitrogen',
326             );
327              
328             # http://en.wikipedia.org/wiki/Ubuntu_%28operating_system%29#Releases
329             my %ubuntu = (
330             '4.10' => 'Warty Warthog',
331             '5.04' => 'Hoary Hedgehog',
332             '5.10' => 'Breezy Badger',
333             '6.06' => 'Dapper Drake',
334             '6.10' => 'Edgy Eft',
335             '7.04' => 'Feisty Fawn',
336             '7.10' => 'Gutsy Gibbon',
337             '8.04' => 'Hardy Heron',
338             '8.10' => 'Intrepid Ibex',
339             '9.04' => 'Jaunty Jackalope',
340             '9.10' => 'Karmic Koala',
341             '10.04' => 'Lucid Lynx',
342             '10.10' => 'Maverick Meerkat',
343             '11.04' => 'Natty Narwhal',
344             '11.10' => 'Oneiric Ocelot',
345             '12.04' => 'Precise Pangolin',
346             '12.10' => 'Quantal Quetzal',
347             '13.04' => 'Raring Ringtail',
348             '13.10' => 'Saucy Salamander',
349             '14.04' => 'Trusty Tahr',
350             '14.10' => 'Utopic Unicorn',
351             '15.04' => 'Vivid Vervet',
352             '15.10' => 'Wily Werewolf',
353             '16.04' => 'Xenial Xerus',
354             );
355              
356             my %distributions = (
357             'Adamantix' => { codenames => \%default, files => [ qw( /etc/adamantix_version ) ] },
358             'Annvix' => { codenames => \%default, files => [ qw( /etc/annvix-release ) ] },
359             'Arch Linux' => { codenames => \%archlinux, files => [ qw( /etc/arch-release ) ] },
360             'Arklinux' => { codenames => \%default, files => [ qw( /etc/arklinux-release ) ] },
361             'Aurox Linux' => { codenames => \%default, files => [ qw( /etc/aurox-release ) ] },
362             'BlackCat' => { codenames => \%default, files => [ qw( /etc/blackcat-release ) ] },
363             'Cobalt' => { codenames => \%default, files => [ qw( /etc/cobalt-release ) ] },
364             'Conectiva' => { codenames => \%default, files => [ qw( /etc/conectiva-release ) ] },
365             'CrunchBang Linux' => { codenames => \%crunch, files => [ qw( /etc/lsb-release-crunchbang /etc/lsb-release ) ] },
366             'Debian' => { codenames => \%debian, key => 'debian', files => [ qw( /etc/debian_version /etc/debian_release ) ] },
367             'Fedora Core' => { codenames => \%fedora, key => 'fedora', files => [ qw( /etc/fedora-release ) ] },
368             'Gentoo Linux' => { codenames => \%default, key => 'gentoo', files => [ qw( /etc/gentoo-release ) ] },
369             'Immunix' => { codenames => \%default, files => [ qw( /etc/immunix-release ) ] },
370             'Knoppix' => { codenames => \%default, files => [ qw( /etc/knoppix_version ) ] },
371             'Libranet' => { codenames => \%default, files => [ qw( /etc/libranet_version ) ] },
372             'Linux-From-Scratch' => { codenames => \%default, files => [ qw( /etc/lfs-release ) ] },
373             'Linux-PPC' => { codenames => \%default, files => [ qw( /etc/linuxppc-release ) ] },
374             'Mandrake' => { codenames => \%mandriva, files => [ qw( /etc/mandrake-release ) ] },
375             'Mandriva' => { codenames => \%mandriva, files => [ qw( /etc/mandriva-release /etc/mandrake-release /etc/mandakelinux-release ) ] },
376             'Mandrake Linux' => { codenames => \%mandriva, files => [ qw( /etc/mandriva-release /etc/mandrake-release /etc/mandakelinux-release ) ] },
377             'MkLinux' => { codenames => \%default, files => [ qw( /etc/mklinux-release ) ] },
378             'Novell Linux Desktop' => { codenames => \%default, files => [ qw( /etc/nld-release ) ] },
379             'Pardus' => { codenames => \%default, key => 'pardus', files => [ qw( /etc/pardus-release ) ] },
380             'PLD Linux' => { codenames => \%default, files => [ qw( /etc/pld-release ) ] },
381             'Red Flag' => { codenames => \%default, key => 'redflag', files => [ qw( /etc/redflag-release ) ] },
382             'Red Hat Enterprise Linux' => { codenames => \%rhel, key => 'rhel', files => [ qw( /etc/redhat-release /etc/redhat_version ) ] },
383             'Red Hat Linux' => { codenames => \%redhat, key => 'redhat', files => [ qw( /etc/redhat-release /etc/redhat_version ) ] },
384             'Scientific Linux' => { codenames => \%scientific, files => [ qw( /etc/lsb-release ) ] },
385             'Slackware' => { codenames => \%default, key => 'slackware', files => [ qw( /etc/slackware-version /etc/slackware-release ) ] },
386             'SME Server' => { codenames => \%default, files => [ qw( /etc/e-smith-release ) ] },
387             'Sun JDS' => { codenames => \%default, files => [ qw( /etc/sun-release ) ] },
388             'SUSE Linux' => { codenames => \%default, key => 'suse', files => [ qw( /etc/SuSE-release /etc/novell-release ) ] },
389             'SUSE Linux ES9' => { codenames => \%default, key => 'suse', files => [ qw( /etc/sles-release ) ] },
390             'Tiny Sofa' => { codenames => \%default, files => [ qw( /etc/tinysofa-release ) ] },
391             'Trustix Secure Linux' => { codenames => \%default, files => [ qw( /etc/trustix-release ) ] },
392             'TurboLinux' => { codenames => \%default, files => [ qw( /etc/turbolinux-release ) ] },
393             'Ubuntu Linux' => { codenames => \%ubuntu, files => [ qw( /etc/lsb-release ) ] },
394             'UltraPenguin' => { codenames => \%default, files => [ qw( /etc/ultrapenguin-release ) ] },
395             'UnitedLinux' => { codenames => \%default, files => [ qw( /etc/UnitedLinux-release ) ] },
396             'VA-Linux/RH-VALE' => { codenames => \%default, files => [ qw( /etc/va-release ) ] },
397             'Yellow Dog' => { codenames => \%default, files => [ qw( /etc/yellowdog-release ) ] },
398             'Yoper' => { codenames => \%default, files => [ qw( /etc/yoper-release ) ] },
399             );
400              
401             my %version_pattern = (
402             'gentoo' => 'Gentoo Base System version (.*)',
403             'debian' => '(.+)',
404             'suse' => 'VERSION = (.*)',
405             'fedora' => 'Fedora Core release (\d+) \(',
406             'redflag' => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
407             'redhat' => 'Red Hat Linux release (.*) \(',
408             'rhel' => 'Red Hat Enterprise Linux(?: Server)? release (.*) \(',
409             'slackware' => '^Slackware (.+)$',
410             'pardus' => '^Pardus (.+)$',
411             );
412              
413             my %oslabel_pattern = (
414             'suse' => '^(\S+)',
415             'rhel' => '(Red Hat Enterprise Linux(?: Server)?) release (.*) \(',
416             );
417              
418             #----------------------------------------------------------------------------
419              
420             sub new {
421 1     1 1 1 my ($class) = @_;
422 1         2 my $self = {};
423 1         1 bless $self, $class;
424              
425 1         9 return $self;
426             }
427              
428             sub get_info {
429 1     1 1 1 my $self = shift;
430              
431 1         3 for my $cmd (keys %commands) {
432 8         226411 $self->{cmds}{$cmd} = `$commands{$cmd} 2>/dev/null`;
433 8         127 $self->{cmds}{$cmd} =~ s/\s+$//s;
434 8 100       114 $self->{info}{$cmd} = $self->{cmds}{$cmd} if($cmd !~ /^_/);
435             }
436              
437 1         16 $self->{info}{osflag} = $^O;
438 1         6 $self->{info}{kernel} = lc($self->{info}{kname}) . '-' . $self->{info}{kvers};
439              
440 1 50       14 $self->{info}{is32bit} = $self->{info}{archname} !~ /_(64)$/ ? 1 : 0;
441 1 50       7 $self->{info}{is64bit} = $self->{info}{archname} =~ /_(64)$/ ? 1 : 0;
442              
443 1 50       5 if($self->{cmds}{'_lsb'}) {
444 1         11 ($self->{info}{oslabel}) = $self->{cmds}{'_lsb'} =~ /Distributor ID:\s*(.*?)\n/si;
445 1         8 ($self->{info}{osvers}) = $self->{cmds}{'_lsb'} =~ /Release:\s*(.*?)\n/si;
446 1         5 ($self->{info}{codename}) = $self->{cmds}{'_lsb'} =~ /Codename:\s*(.*)\n?/si;
447             } else {
448 0         0 $self->_release_version();
449             }
450              
451 1         24 $self->{info}{source}{$commands{$_}} = $self->{cmds}{$_} for(keys %commands);
452 1         12 return $self->{info};
453             }
454              
455             #----------------------------------------------------------------------------
456              
457             sub _release_version {
458 0     0     my $self = shift;
459              
460 0           for my $label (keys %distributions) {
461 0           for my $file (@{ $distributions{$label}->{files} }) {
  0            
462 0 0         next unless(-f $file);
463 0           my $line = `cat $file 2>/dev/null`;
464              
465 0           my ($version,$oslabel);
466 0 0         if($distributions{$label}->{key}) {
467 0 0         if($version_pattern{ $distributions{$label}->{key} }) {
468 0           ($version) = $line =~ /$version_pattern{ $distributions{$label}->{key} }/si;
469             }
470 0 0         if($oslabel_pattern{ $distributions{$label}->{key} }) {
471 0           ($oslabel) = $line =~ /$oslabel_pattern{ $distributions{$label}->{key} }/si;
472             }
473             }
474              
475 0 0         $version = $line unless($version);
476 0           $version =~ s/\s*$//;
477              
478 0 0         unless($oslabel) {
479 0 0         if($self->{cmds}{'_issue1'}) {
    0          
480 0           ($oslabel) = $self->{cmds}{'_issue1'} =~ /^(\S*)/;
481             } elsif($self->{cmds}{'_issue2'}) {
482 0           ($oslabel) = $self->{cmds}{'_issue2'} =~ /^(\S*)/;
483             }
484 0   0       $oslabel ||= $label; # a last resort
485             }
486              
487 0           $self->{info}{oslabel} = $oslabel;
488 0           $self->{info}{osvers} = $version;
489 0           $commands{'_cat'} = "cat $file";
490 0           $self->{cmds}{'_cat'} = $line;
491              
492 0           for my $vers (keys %{ $distributions{$label}->{codenames} }) {
  0            
493 0 0         if($version =~ /^$vers\b/) {
494 0           $self->{info}{codename} = $distributions{$label}->{codenames}{$vers};
495 0           return;
496             }
497             }
498              
499 0           return;
500             }
501             }
502             }
503              
504             1;
505              
506             __END__