File Coverage

blib/lib/Sys/Info/Driver/Linux/OS.pm
Criterion Covered Total %
statement 143 167 85.6
branch 21 52 40.3
condition 5 24 20.8
subroutine 30 31 96.7
pod 16 16 100.0
total 215 290 74.1


line stmt bran cond sub pod time code
1             package Sys::Info::Driver::Linux::OS;
2 1     1   146003 use strict;
  1         2  
  1         42  
3 1     1   6 use warnings;
  1         3  
  1         36  
4 1     1   16 use vars qw( $VERSION );
  1         2  
  1         46  
5 1     1   5 use base qw( Sys::Info::Base );
  1         1  
  1         84  
6 1     1   991 use POSIX ();
  1         7745  
  1         30  
7 1     1   8 use Cwd;
  1         6  
  1         82  
8 1     1   7 use Carp qw( croak );
  1         2  
  1         54  
9 1     1   649 use Sys::Info::Driver::Linux;
  1         2  
  1         55  
10 1     1   701 use Sys::Info::Driver::Linux::Constants qw( :all );
  1         3  
  1         274  
11 1     1   7 use constant FSTAB_LENGTH => 6;
  1         2  
  1         2508  
12              
13             ##no critic (InputOutput::ProhibitBacktickOperators)
14              
15             $VERSION = '0.7903';
16              
17             sub init {
18 1     1 1 4037 my $self = shift;
19 1         12 $self->{OSVERSION} = undef; # see _populate_osversion
20 1         4 $self->{FILESYSTEM} = undef; # see _populate_fs
21 1         3 return;
22             }
23              
24             # unimplemented
25 1     1 1 413 sub logon_server {}
26              
27             sub edition {
28 1     1 1 516 return shift->_populate_osversion->{OSVERSION}{RAW}{EDITION};
29             }
30              
31             sub tz {
32 2     2 1 765 my $self = shift;
33 2 50       42 return if ! -e proc->{timezone};
34 2         9 chomp( my $rv = $self->slurp( proc->{timezone} ) );
35 2         237 return $rv;
36             }
37              
38             sub meta {
39 1     1 1 17 my $self = shift->_populate_osversion;
40              
41 1         11 require POSIX;
42 1         5 require Sys::Info::Device;
43              
44 1         8 my $cpu = Sys::Info::Device->new('CPU');
45 1         50 my $arch = ($cpu->identify)[0]->{architecture};
46 1         29 my %mem = $self->_parse_meminfo;
47 1         70 my @swaps = $self->_parse_swap;
48 1         4 my %info;
49              
50 1         6 $info{manufacturer} = $self->{OSVERSION}{MANUFACTURER};
51 1         3 $info{build_type} = undef;
52 1         4 $info{owner} = undef;
53 1         4 $info{organization} = undef;
54 1         5 $info{product_id} = undef;
55 1         7 $info{install_date} = $self->{OSVERSION}{RAW}{BUILD_DATE};
56 1         4 $info{boot_device} = undef;
57              
58 1         172 $info{physical_memory_total} = $mem{MemTotal};
59 1         6 $info{physical_memory_available} = $mem{MemFree};
60 1         4 $info{page_file_total} = $mem{SwapTotal};
61 1         4 $info{page_file_available} = $mem{SwapFree};
62              
63             # windows specific
64 1         3 $info{windows_dir} = undef;
65 1         4 $info{system_dir} = undef;
66              
67 1         3 $info{system_manufacturer} = undef;
68 1         4 $info{system_model} = undef;
69 1         11 $info{system_type} = sprintf '%s based Computer', $arch;
70              
71 1         5 $info{page_file_path} = join ', ', map { $_->{Filename} } @swaps;
  2         12  
72              
73 1         188 return %info;
74             }
75              
76             sub tick_count {
77 2     2 1 13 my $self = shift;
78 2   50     13 my $uptime = $self->slurp( proc->{uptime} ) || return 0;
79 2         291 my @uptime = split /\s+/xms, $uptime;
80             # this file has two entries. uptime is the first one. second: idle time
81 2         12 return $uptime[UP_TIME];
82             }
83              
84             sub name {
85 3     3 1 42 my($self, @args) = @_;
86 3         22 $self->_populate_osversion;
87 3 50       18 my %opt = @args % 2 ? () : @args;
88 3 100       11 my $id = $opt{long} ? 'LONGNAME' : 'NAME';
89 3 100       26 return $self->{OSVERSION}{ $opt{edition} ? $id . '_EDITION' : $id };
90             }
91              
92 1     1 1 5 sub version { return shift->_populate_osversion->{OSVERSION}{VERSION} }
93 1     1 1 3 sub build { return shift->_populate_osversion->{OSVERSION}{RAW}{BUILD_DATE} }
94 1     1 1 27 sub uptime { return time - shift->tick_count }
95              
96             # user methods
97             sub is_root {
98 9 50   9 1 7759 return 0 if defined &Sys::Info::EMULATE;
99 9         18 my $name = login_name();
100 9         1070 my $id = POSIX::geteuid();
101 9         427 my $gid = POSIX::getegid();
102 9 50       210 return 0 if $@;
103 9 50 33     37 return 0 if ! defined $id || ! defined $gid;
104 9   33     763 return $id == 0 && $gid == 0 && $name eq 'root';
105             }
106              
107             sub login_name {
108 11     11 1 14503 my($self, @args) = @_;
109 11 50       41 my %opt = @args % 2 ? () : @args;
110 11   50     270 my $login = POSIX::getlogin() || return;
111 0 0       0 my $rv = eval { $opt{real} ? (getpwnam $login)[REAL_NAME_FIELD] : $login };
  0         0  
112 0 0       0 $rv =~ s{ [,]{3,} \z }{}xms if $opt{real};
113 0         0 return $rv;
114             }
115              
116 2     2 1 779 sub node_name { return shift->uname->{nodename} }
117              
118             sub domain_name {
119 2     2 1 906 my $self = shift;
120             # hmmmm...
121 2         13 foreach my $line ( $self->read_file( proc->{resolv} ) ) {
122 6         278 chomp $line;
123 6 100       21 if ( $line =~ m{\A domain \s+ (.*) \z}xmso ) {
124 2         8 return $1;
125             }
126             }
127 0         0 my $sys = qx{dnsdomainname 2> /dev/null};
128 0         0 return $sys;
129             }
130              
131             sub fs {
132 1     1 1 3 my $self = shift;
133 1         11 $self->{current_dir} = Cwd::getcwd();
134              
135 1         2 my(@fstab, @junk, $re);
136 1         7 foreach my $line( $self->read_file( proc->{fstab} ) ) {
137 1         109 chomp $line;
138 1 50       7 next if $line =~ m{ \A \# }xms;
139 0         0 @junk = split /\s+/xms, $line;
140 0 0 0     0 next if ! @junk || @junk != FSTAB_LENGTH;
141 0 0       0 next if lc($junk[FS_TYPE]) eq 'swap'; # ignore swaps
142 0         0 $re = $junk[MOUNT_POINT];
143 0 0       0 next if $self->{current_dir} !~ m{\Q$re\E}xmsi;
144 0         0 push @fstab, [ $re, $junk[FS_TYPE] ];
145             }
146              
147 1 50       4 @fstab = reverse sort { $a->[0] cmp $b->[0] } @fstab if @fstab > 1;
  0         0  
148 1         5 my $fstype = $fstab[0]->[1];
149 1         9 my $attr = $self->_fs_attributes( $fstype );
150             return
151 0         0 filesystem => $fstype,
152 1 50       18 ($attr ? %{$attr} : ())
153             ;
154             }
155              
156 1 50   1 1 382 sub bitness { return shift->uname->{machine} =~ m{64}xms ? '64' : '32' }
157              
158             # ------------------------[ P R I V A T E ]------------------------ #
159              
160             sub _parse_meminfo {
161 1     1   4 my $self = shift;
162 1         3 my %mem;
163 1         7 foreach my $line ( split /\n/xms, $self->slurp( proc->{meminfo} ) ) {
164 42         1852 chomp $line;
165 42         118 my($k, $v) = split /:/xms, $line;
166             # units in KB
167 42         125 $mem{ $k } = (split /\s+/xms, $self->trim( $v ) )[0];
168             }
169 1         73 return %mem;
170             }
171              
172             sub _parse_swap {
173 1     1   3 my $self = shift;
174 1         9 my @swaps = split /\n/xms, $self->slurp( proc->{swaps} );
175 1         208 my @swap_title = split /\s+/xms, shift @swaps;
176 1         4 my @swap_list;
177 1         5 foreach my $line ( @swaps ) {
178 2         4 chomp $line;
179 2         10 my @data = split /\s+/xms, $line;
180 10         44 push @swap_list,
181             {
182 2         10 map { $swap_title[$_] => $data[$_] } 0..$#swap_title
183             };
184             }
185 1         8 return @swap_list;
186             }
187              
188             sub _ip {
189 0     0   0 my $self = shift;
190 0         0 my $cmd = q{/sbin/ifconfig};
191 0 0 0     0 return if ! -e $cmd || ! -x _;
192 0         0 my $raw = qx($cmd);
193 0 0       0 return if not $raw;
194 0         0 my @raw = split /inet addr/xms, $raw;
195 0 0 0     0 return if ! @raw || @raw < 2 || ! $raw[1];
      0        
196 0 0       0 if ( $raw[1] =~ m{(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})}xms ) {
197 0         0 return $1;
198             }
199 0         0 return;
200             }
201              
202             sub _populate_osversion {
203 7     7   17 my $self = shift;
204 7 100       47 return $self if $self->{OSVERSION};
205 1         1186 require Sys::Info::Driver::Linux::OS::Distribution;
206 1         19 my $distro = Sys::Info::Driver::Linux::OS::Distribution->new;
207 1         4 my $osname = $distro->name;
208 1         5 my $V = $distro->version;
209 1         5 my $edition = $distro->edition;
210 1         5 my $kernel = $distro->kernel;
211 1         6 my $build = $distro->build;
212 1         4 my $build_date = $distro->build_date;
213 1   50     6 my $manufacturer = $distro->manufacturer || q{};
214              
215 1 50       44 $self->{OSVERSION} = {
    50          
    50          
216             NAME => $osname,
217             NAME_EDITION => $edition ? "$osname ($edition)" : $osname,
218             LONGNAME => q{}, # will be set below
219             LONGNAME_EDITION => q{}, # will be set below
220             VERSION => $V,
221             KERNEL => $kernel,
222             MANUFACTURER => $manufacturer,
223             RAW => {
224             BUILD => defined $build ? $build : 0,
225             BUILD_DATE => defined $build_date ? $build_date : 0,
226             EDITION => $edition,
227             },
228             };
229              
230 1         3 my $o = $self->{OSVERSION};
231 1         2 my $t = '%s %s (kernel: %s)';
232 1         7 $o->{LONGNAME} = sprintf $t, $o->{NAME}, $o->{VERSION}, $kernel;
233 1         4 $o->{LONGNAME_EDITION} = sprintf $t, $o->{NAME_EDITION}, $o->{VERSION}, $kernel;
234 1         19 return $self;
235             }
236              
237             sub _fs_attributes {
238 1     1   3 my $self = shift;
239 1         2 my $fs = shift;
240              
241             return {
242 1         762 ext3 => {
243             case_sensitive => 1, #'supports case-sensitive filenames',
244             preserve_case => 1, #'preserves the case of filenames',
245             unicode => 1, #'supports Unicode in filenames',
246             #acl => '', #'preserves and enforces ACLs',
247             #file_compression => '', #'supports file-based compression',
248             #disk_quotas => '', #'supports disk quotas',
249             #sparse => '', #'supports sparse files',
250             #reparse => '', #'supports reparse points',
251             #remote_storage => '', #'supports remote storage',
252             #compressed_volume => '', #'is a compressed volume (e.g. DoubleSpace)',
253             #object_identifiers => '', #'supports object identifiers',
254             efs => '1', #'supports the Encrypted File System (EFS)',
255             #max_file_length => '';
256             },
257             }->{$fs};
258             }
259              
260             1;
261              
262             __END__