burak / CPAN-Sys-Info
Fetch information from the host system (Perl)
Clone this repository (size: 40.6 KB): HTTPS / SSH
$ hg clone http://bitbucket.org/burak/cpan-sys-info/
| commit 7: | b65a1894df53 |
| parent 6: | f73dff73ae1b |
| branch: | default |
update test suite
Burak Gursoy
12 months ago
Changed (Δ3.5 KB):
raw changeset »
Changes (3 lines added, 0 lines removed)
lib/Sys/Info.pm (1 lines added, 1 lines removed)
t/03-basic.t (9 lines added, 86 lines removed)
t/04-unknown.t
t/05-unknown2.t
t/06-device-cpu.t
| … | … | @@ -2,6 +2,9 @@ Revision history for Perl extension Sys: |
2 |
2 |
|
3 |
3 |
Time zone is GMT+2. |
4 |
4 |
|
5 |
0.69_06 Sat Mar 14 06:42:17 2009 |
|
6 |
=> Test suite update. |
|
7 |
||
5 |
8 |
0.69_05 Sat Mar 14 01:59:01 2009 |
6 |
9 |
=> Bump version. |
7 |
10 |
Up to file-list lib/Sys/Info.pm:
| … | … | @@ -4,7 +4,7 @@ use vars qw( $VERSION @EXPORT_OK ); |
4 |
4 |
use Carp qw( croak ); |
5 |
5 |
use Sys::Info::Constants qw( OSID ); |
6 |
6 |
|
7 |
$VERSION = '0.69_0 |
|
7 |
$VERSION = '0.69_06'; |
|
8 |
8 |
@EXPORT_OK = qw( OSID ); |
9 |
9 |
|
10 |
10 |
__PACKAGE__->_mk_object( $_ ) for qw( OS Device ); |
| … | … | @@ -3,94 +3,17 @@ use strict; |
3 |
3 |
use Sys::Info qw(OSID); |
4 |
4 |
use Data::Dumper; |
5 |
5 |
use Test::More qw( no_plan ); |
6 |
use constant NA => 'N/A'; |
|
7 |
||
8 |
my $BUF = "\n %s"; |
|
9 |
6 |
|
10 |
7 |
ok( defined &OSID, "OSID defined"); |
11 |
8 |
|
12 |
# Just try the interface methods |
|
13 |
# ... see if they all exist |
|
9 |
ok(my $info = Sys::Info->new , "Sys::Info object is defined"); |
|
10 |
ok(my $os = $info->os , "OS object is defined"); |
|
11 |
ok(my $cpu = $info->device('CPU'), "CPU object is defined"); |
|
14 |
12 |
|
15 |
my $info = Sys::Info->new; |
|
16 |
my $os = $info->os; |
|
17 |
|
|
13 |
ok( defined $os->name, "OS object called with name"); |
|
14 |
ok( $cpu->identify || 1, "CPU object called with identify"); |
|
18 |
15 |
|
19 |
print "\n[Sys::Info]\n"; |
|
20 |
printf "Perl version : %s\n" , $info->perl; |
|
21 |
printf "Perl build : %s\n" , $info->perl_build; |
|
22 |
printf "Perl long version: %s\n" , $info->perl_long; |
|
23 |
printf "HTTP Daemon : %s\n" , $info->httpd || NA; |
|
24 |
printf "IP Address : %s\n" , $os->ip || NA; |
|
25 |
||
26 |
print "\n[Sys::Info::OS]\n"; |
|
27 |
||
28 |
printf "OS name : %s\n" , $os->name; |
|
29 |
printf "OS long name : %s\n" , $os->name( long => 1 ); |
|
30 |
printf "OS long name+ed : %s\n" , $os->name( long => 1, edition => 1 ); |
|
31 |
printf "OS edition : %s\n" , $os->edition || NA; |
|
32 |
printf "OS version : %s\n" , $os->version; |
|
33 |
printf "OS build : %s\n" , $os->build; |
|
34 |
printf "OS uptime : %s\n" , up($os->uptime) || NA; |
|
35 |
printf "Tick count : %s\n" , tick($os->tick_count); |
|
36 |
printf "Node name : %s\n" , $os->node_name || NA; |
|
37 |
printf "Domain name : %s\n" , $os->domain_name || NA; |
|
38 |
printf "Workgroup : %s\n" , $os->workgroup || NA; |
|
39 |
printf "User name : %s\n" , $os->login_name || NA; |
|
40 |
printf "Real user name : %s\n" , $os->login_name( real => 1 ) || NA; |
|
41 |
printf "Windows : %s\n" , $os->is_windows ? 'yes' : 'no'; |
|
42 |
printf "Windows : %s\n" , $os->is_win32 ? 'yes' : 'no'; |
|
43 |
printf "Windows : %s\n" , $os->is_win ? 'yes' : 'no'; |
|
44 |
printf "Windows NT : %s\n" , $os->is_winnt ? 'yes' : 'no'; |
|
45 |
printf "Windows 9x : %s\n" , $os->is_win95 ? 'yes' : 'no'; |
|
46 |
printf "Windows 9x : %s\n" , $os->is_win9x ? 'yes' : 'no'; |
|
47 |
printf "Linux : %s\n" , $os->is_linux ? 'yes' : 'no'; |
|
48 |
printf "Linux : %s\n" , $os->is_lin ? 'yes' : 'no'; |
|
49 |
printf "Unknown OS : %s\n" , $os->is_unknown ? 'yes' : 'no'; |
|
50 |
printf "Administrator : %s\n" , $os->is_root ? 'yes' : 'no'; |
|
51 |
printf "Administrator : %s\n" , $os->is_admin ? 'yes' : 'no'; |
|
52 |
printf "Administrator : %s\n" , $os->is_admin_user ? 'yes' : 'no'; |
|
53 |
printf "Administrator : %s\n" , $os->is_adminuser ? 'yes' : 'no'; |
|
54 |
printf "Administrator : %s\n" , $os->is_root_user ? 'yes' : 'no'; |
|
55 |
printf "Administrator : %s\n" , $os->is_super_user ? 'yes' : 'no'; |
|
56 |
printf "Administrator : %s\n" , $os->is_superuser ? 'yes' : 'no'; |
|
57 |
printf "Administrator : %s\n" , $os->is_su ? 'yes' : 'no'; |
|
58 |
printf "Logon Server : %s\n" , $os->logon_server || NA; |
|
59 |
printf "Time Zone : %s\n" , $os->tz || NA; |
|
60 |
printf "File system : $BUF\n" , dumper( FS => { $os->fs } ); |
|
61 |
printf "OS meta : $BUF\n" , dumper( META => { $os->meta } ); |
|
62 |
||
63 |
printf "Windows CD Key : %s\n" , eval { $os->cdkey } || NA; |
|
64 |
printf "MSO CD Key : %s\n" , eval {($os->cdkey( office => 1 ))[0] } || NA; |
|
65 |
||
66 |
print "\n[Sys::Info::CPU]\n"; |
|
67 |
||
68 |
printf "CPU Name : %s\n" , scalar($cpu->identify) || NA; |
|
69 |
printf "CPU Speed : %s MHz\n" , $cpu->speed || NA; |
|
70 |
printf "CPU load average : %s\n" , $cpu->load || NA; |
|
71 |
printf "Number of CPUs : %s\n" , $cpu->count || NA; |
|
72 |
printf "CPU probe : $BUF\n" , dumper(CPU => $cpu->identify); |
|
73 |
||
74 |
ok(1); |
|
75 |
||
76 |
#------------------------------------------------------------------------------# |
|
77 |
||
78 |
sub dumper { |
|
79 |
my $n = shift; |
|
80 |
my $ref = (@_ == 1) ? shift : \@_; |
|
81 |
Data::Dumper->Dump([$ref], ['*'.$n]) |
|
82 |
} |
|
83 |
||
84 |
sub up { |
|
85 |
my $up = shift || return 0; |
|
86 |
scalar(localtime $up); |
|
87 |
} |
|
88 |
||
89 |
sub tick { |
|
90 |
my $tick = shift || return 0; |
|
91 |
eval { require Time::Elapsed; }; |
|
92 |
return sprintf( "%.2f days", $tick / (60*60*24) ) if $@; |
|
93 |
return Time::Elapsed::elapsed( $tick ); |
|
94 |
} |
|
95 |
||
96 |
1; |
|
16 |
ok( defined $info->perl , "Able to call perl()" ); |
|
17 |
ok( defined $info->perl_build, "Able to call perl_build()" ); |
|
18 |
ok( defined $info->perl_long , "Able to call perl_long()" ); |
|
19 |
ok( $info->httpd || 1 , "Able to call httpd()" ); |