1package Sys::Info::Driver::BSD::OS;
2use strict;
3use warnings;
4use vars qw( $VERSION );
5use base qw( Sys::Info::Base );
6use POSIX ();
7use Cwd;
8use Carp qw( croak );
9use Sys::Info::Constants qw( USER_REAL_NAME_FIELD );
10use Sys::Info::Driver::BSD;
11
12$VERSION = '0.7801';
13
14my %OSVERSION;
15
16my $MANUFACTURER = {
17    # taken from Wikipedia
18    dragonfly => 'The DragonFly Project',
19    freebsd => 'The FreeBSD Project',
20    openbsd => 'The OpenBSD Project',
21    netbsd  => 'The NetBSD Foundation',
22};
23
24# unimplemented
25sub logon_server {}
26
27sub edition {
28    my $self = shift->_populate_osversion;
29    return $OSVERSION{RAW}->{EDITION};
30}
31
32sub tz {
33    my $self = shift;
34    return POSIX::strftime('%Z', localtime);
35}
36
37sub meta {
38    my $self = shift;
39    $self->_populate_osversion();
40
41    require POSIX;
42    require Sys::Info::Device;
43
44    my $cpu       = Sys::Info::Device->new('CPU');
45    my $arch      = ($cpu->identify)[0]->{architecture};
46    my $physmem   = fsysctl('hw.physmem');
47    my $usermem   = fsysctl('hw.usermem');
48    my $swap_call = $^O eq 'openbsd' ? '/sbin/swapctl -l' : '/usr/sbin/swapinfo';
49    my $swap_buf  = qx($swap_call 2>&1);
50    my %swap;
51    if ( $swap_buf ) {
52        foreach my $line ( split m{\n}xms, $swap_buf ) {
53            chomp $line;
54            next if $line =~ m{ \A Device }xms;
55            @swap{ qw/ path size used / } = split m{\s+}xms, $line;
56            last;
57        }
58    }
59
60    my %info;
61
62    $info{manufacturer}              = $MANUFACTURER->{ $^O };
63    $info{build_type}                = undef;
64    $info{owner}                     = undef;
65    $info{organization}              = undef;
66    $info{product_id}                = undef;
67    $info{install_date}              = undef;
68    $info{boot_device}               = undef;
69
70    $info{physical_memory_total}     = $physmem;
71    $info{physical_memory_available} = $physmem - $usermem;
72    $info{page_file_total}           = %swap ? $swap{size} : undef;
73    $info{page_file_available}       = %swap ? $swap{size} - $swap{used} : undef;
74
75    # windows specific
76    $info{windows_dir}               = undef;
77    $info{system_dir}                = undef;
78
79    $info{system_manufacturer}       = undef;
80    $info{system_model}              = undef;
81    $info{system_type}               = sprintf '%s based Computer', $arch;
82
83    $info{page_file_path}            = $swap{path};
84
85    return %info;
86}
87
88sub tick_count {
89    my $self = shift;
90    return time - $self->uptime;
91}
92
93sub name {
94    my($self, @args) = @_;
95    $self->_populate_osversion;
96    my %opt  = @args % 2 ? () : @args;
97    my $id   = $opt{long} ? ($opt{edition} ? 'LONGNAME_EDITION' : 'LONGNAME')
98             :              ($opt{edition} ? 'NAME_EDITION'     : 'NAME'    )
99             ;
100    return $OSVERSION{ $id };
101}
102
103
104sub version   { shift->_populate_osversion(); return $OSVERSION{VERSION}      }
105sub build     { shift->_populate_osversion(); return $OSVERSION{RAW}->{BUILD_DATE} }
106sub uptime    {                               return fsysctl 'kern.boottime' }
107
108# user methods
109sub is_root {
110    my $name = login_name();
111    my $id   = POSIX::geteuid();
112    my $gid  = POSIX::getegid();
113    return 0 if $@;
114    return 0 if ! defined $id || ! defined $gid;
115    return $id == 0 && $gid == 0; # && $name eq 'root'; # $name is never root!
116}
117
118sub login_name {
119    my($self, @args) = @_;
120    my %opt   = @args % 2 ? () : @args;
121    my $login = POSIX::getlogin() || return;
122    my $rv    = eval { $opt{real} ? (getpwnam $login)[USER_REAL_NAME_FIELD] : $login };
123    $rv =~ s{ [,]{3,} \z }{}xms if $opt{real};
124    return $rv;
125}
126
127sub node_name { return shift->uname->{nodename} }
128
129sub domain_name { }
130
131sub fs {
132    my $self = shift;
133    return unimplemented => 1;
134}
135
136sub bitness {
137    my $self = shift;
138    return;
139}
140
141# ------------------------[ P R I V A T E ]------------------------ #
142
143sub _file_has_substr {
144    my $self = shift;
145    my $file = shift;
146    my $str  = shift;
147    return if ! -e $file || ! -f _;
148    my $raw = $self->slurp( $file ) =~ m{$str}xms;
149    return $raw;
150}
151
152sub _probe_edition {
153    my $self = shift;
154    my $name = shift;
155
156    # Check DesktopBSD
157    # /etc/motd
158    # /var/db/pkg/desktopbsd-tools-1.1_2/
159    return if $name ne 'FreeBSD';
160    my $dbsd = quotemeta '# $DesktopBSD$';
161
162    return 'DesktopBSD' if
163        $self->_file_has_substr('/etc/motd'           , qr{Welcome \s to \s DesktopBSD}xms ) ||
164        $self->_file_has_substr('/etc/devd.conf'      , qr{\A $dbsd}xms ) ||
165        $self->_file_has_substr('/etc/rc.d/clearmedia', qr{\A $dbsd}xms );
166    return; # fail!
167}
168
169sub _populate_osversion {
170    return if %OSVERSION;
171    my $self    = shift;
172    require POSIX;
173    my($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
174
175    my(undef, $raw)  = split m{\#}xms, $version;
176    my($date, undef) = $raw ? split m{ \s+ \S+ \z }xms, $raw : (undef, undef);
177    my $build_date = $date ? $self->date2time( $date ) : undef;
178    my $build      = $date;
179    my $edition    = $self->_probe_edition( $sysname );
180
181    my $kernel = '???';
182
183    %OSVERSION = (
184        NAME             => $sysname,
185        NAME_EDITION     => $edition ? "$sysname ($edition)" : $sysname,
186        LONGNAME         => q{}, # will be set below
187        LONGNAME_EDITION => q{}, # will be set below
188        VERSION  => $release,
189        KERNEL   => undef,
190        RAW      => {
191                        BUILD      => defined $build      ? $build      : 0,
192                        BUILD_DATE => defined $build_date ? $build_date : 0,
193                        EDITION    => $edition,
194                    },
195    );
196
197    $OSVERSION{LONGNAME}         = sprintf '%s %s (kernel: %s)',
198                                   @OSVERSION{ qw/ NAME         VERSION / },
199                                   $kernel;
200    $OSVERSION{LONGNAME_EDITION} = sprintf '%s %s (kernel: %s)',
201                                   @OSVERSION{ qw/ NAME_EDITION VERSION / },
202                                   $kernel;
203    return;
204}
205
2061;
207
208__END__
209
210=head1 NAME
211
212Sys::Info::Driver::BSD::OS - BSD backend
213
214=head1 SYNOPSIS
215
216-
217
218=head1 DESCRIPTION
219
220This document describes version C<0.7801> of C<Sys::Info::Driver::BSD::OS>
221released on C<12 September 2011>.
222
223-
224
225=head1 METHODS
226
227Please see L<Sys::Info::OS> for definitions of these methods and more.
228
229=head2 build
230
231=head2 domain_name
232
233=head2 edition
234
235=head2 fs
236
237=head2 is_root
238
239=head2 login_name
240
241=head2 logon_server
242
243=head2 meta
244
245=head2 name
246
247=head2 node_name
248
249=head2 tick_count
250
251=head2 tz
252
253=head2 uptime
254
255=head2 version
256
257=head2 bitness
258
259=head1 SEE ALSO
260
261L<Sys::Info>, L<Sys::Info::OS>,
262The C</proc> virtual filesystem:
263L<http://www.redhat.com/docs/manuals/linux/RHL-9-Manual/ref-guide/s1-proc-topfiles.html>.
264
265=head1 AUTHOR
266
267Burak Gursoy <burak@cpan.org>.
268
269=head1 COPYRIGHT
270
271Copyright 2009 - 2011 Burak Gursoy. All rights reserved.
272
273=head1 LICENSE
274
275This library is free software; you can redistribute it and/or modify
276it under the same terms as Perl itself, either Perl version 5.8.8 or,
277at your option, any later version of Perl 5 you may have available.
278
279=cut
280