File Coverage

blib/lib/Unix/Processors.pm
Criterion Covered Total %
statement 25 25 100.0
branch 4 6 66.6
condition 2 6 33.3
subroutine 5 5 100.0
pod 1 2 50.0
total 37 44 84.0


line stmt bran cond sub pod time code
1             # Unix::Processors
2             # See copyright, etc in below POD section.
3             ######################################################################
4              
5             =head1 NAME
6              
7             Unix::Processors - Interface to processor (CPU) information
8              
9             =head1 SYNOPSIS
10              
11             use Unix::Processors;
12              
13             my $procs = new Unix::Processors;
14             print "There are ", $procs->max_online, " CPUs at ", $procs->max_clock, "\n";
15             if ($procs->max_online != $procs->max_physical) {
16             print "Hyperthreading between ",$procs->max_physical," physical CPUs.\n";
17             }
18             (my $FORMAT = "%2s %-8s %4s \n") =~ s/\s\s+/ /g;
19             printf($FORMAT, "#", "STATE", "CLOCK", "TYPE", );
20             foreach my $proc (@{$procs->processors}) {
21             printf ($FORMAT, $proc->id, $proc->state, $proc->clock, $proc->type);
22             }
23              
24             =head1 DESCRIPTION
25              
26             This package provides accessors to per-processor (CPU) information.
27             The object is obtained with the Unix::Processors::processors call.
28             the operating system in a OS independent manner.
29              
30             =over 4
31              
32             =item max_online
33              
34             Return number of threading processors currently online. On hyperthreaded
35             Linux systems, this indicates the maximum number of simultaneous threads
36             that may execute; see max_physical for the real physical CPU count.
37              
38             =item max_physical
39              
40             Return number of physical processor cores currently online. For example, a
41             single chip quad-core processor returns four.
42              
43             =item max_socket
44              
45             Returns the number of populated CPU sockets, if known, else the same number
46             as max_physical. For example, a single chip quad-core processor returns
47             one.
48              
49             =item max_clock
50              
51             Return the maximum clock speed across all online processors. Not all OSes support this call.
52              
53             =item processors
54              
55             Return an array of processor references. See the Unix::Processors::Info
56             manual page. Not all OSes support this call.
57              
58             =back
59              
60             =head1 DISTRIBUTION
61              
62             The latest version is available from CPAN and from L.
63              
64             Copyright 1999-2017 by Wilson Snyder. This package is free software; you
65             you can redistribute it and/or modify it under the terms of either the GNU
66             Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.
67              
68             =head1 AUTHORS
69              
70             Wilson Snyder
71              
72             =head1 SEE ALSO
73              
74             L, L
75              
76             =cut
77              
78             package Unix::Processors;
79 1     1   12835 use Unix::Processors::Info;
  1         2  
  1         35  
80              
81             $VERSION = '2.045';
82              
83             require DynaLoader;
84             @ISA = qw(DynaLoader);
85              
86 1     1   6 use strict;
  1         1  
  1         13  
87 1     1   5 use Carp;
  1         1  
  1         164  
88              
89             ######################################################################
90             #### Configuration Section
91              
92             bootstrap Unix::Processors;
93              
94             ######################################################################
95             #### Accessors
96              
97             sub new {
98             # NOP for now, just need a handle for other routines
99 1 50   1 0 114 @_ >= 1 or croak 'usage: Unix::Processors->new ({options})';
100 1         3 my $proto = shift;
101 1   33     5 my $class = ref($proto) || $proto;
102 1         3 my $self = {@_,};
103 1         2 bless $self, $class;
104 1         3 return $self;
105             }
106              
107             sub processors {
108 2 50 33 2 1 1007 my $self = shift; ($self && ref($self)) or croak 'usage: $self->max_online()';
  2         16  
109 2         3 my @list;
110 2         8 for (my $cnt=0; $cnt<64; $cnt++) {
111 128         136 my $val = $cnt;
112 128         133 my $vref = \$val; # Just a reference to a cpu number
113 128         152 bless $vref, 'Unix::Processors::Info';
114 128 100       4873 if ($vref->type) {
115 32         139 push @list, $vref;
116             }
117             }
118 2         8 return \@list;
119             }
120              
121             ######################################################################
122             #### Package return
123             1;