File Coverage

blib/lib/Proc/ProcessTable/Match/PctCPU.pm
Criterion Covered Total %
statement 8 54 14.8
branch 0 36 0.0
condition 0 3 0.0
subroutine 3 5 60.0
pod 2 2 100.0
total 13 100 13.0


line stmt bran cond sub pod time code
1             package Proc::ProcessTable::Match::PctCPU;
2              
3 1     1   54572 use 5.006;
  1         10  
4 1     1   5 use strict;
  1         2  
  1         18  
5 1     1   4 use warnings;
  1         2  
  1         506  
6              
7             =head1 NAME
8              
9             Proc::ProcessTable::Match::PctCPU - Check if a process matches based on the CPU usaged percentage.
10              
11             =head1 VERSION
12              
13             Version 0.0.0
14              
15             =cut
16              
17             our $VERSION = '0.0.0';
18              
19              
20             =head1 SYNOPSIS
21              
22             use Proc::ProcessTable::Match::PctCPU;
23            
24             my %args=(
25             pctcpus=>[
26             0,
27             '>1000',
28             ],
29             );
30            
31             my $checker=Proc::ProcessTable::Match::PctCPU->new( \%args );
32            
33             if ( $checker->match( $proc ) ){
34             print "It matches.\n";
35             }
36              
37             =head1 METHODS
38              
39             =head2 new
40              
41             This intiates the object.
42              
43             It takes a hash reference with one key. One key is required and
44             that is 'pctcpus', which is a array of PctCPUs values to match.
45              
46             The PctCPU values can be prefixed with the equalities below for doing
47             additional comparisons.
48              
49             <
50             <=
51             >
52             >=
53             !
54              
55             Atleast one value must be specified.
56              
57             If the new method fails, it dies.
58              
59             my %args=(
60             pctcpus=>[
61             0,
62             '>1000',
63             ],
64             );
65            
66             my $checker=Proc::ProcessTable::Match::PctCPU->new( \%args );
67              
68             =cut
69              
70             sub new{
71 0     0 1   my %args;
72 0 0         if(defined($_[1])){
73 0           %args= %{$_[1]};
  0            
74             };
75              
76             # run some basic checks to make sure we have the minimum stuff required to work
77 0 0         if ( ! defined( $args{pctcpus} ) ){
78 0           die ('No pctcpus key specified in the argument hash');
79             }
80 0 0         if ( ref( \$args{pctcpus} ) eq 'ARRAY' ){
81 0           die ('The pctcpus key is not a array');
82             }
83 0 0         if ( ! defined $args{pctcpus}[0] ){
84 0           die ('Nothing defined in the pctcpus array');
85             }
86              
87             my $self = {
88             pctcpus=>$args{pctcpus},
89 0           };
90 0           bless $self;
91              
92 0           return $self;
93             }
94              
95             =head2 match
96              
97             Checks if a single Proc::ProcessTable::Process object matches the stack.
98              
99             One argument is taken and that is a Proc::ProcessTable::Process object.
100              
101             The returned value is a boolean.
102              
103             if ( $checker->match( $proc ) ){
104             print "The process matches.\n";
105             }
106              
107             =cut
108              
109             sub match{
110 0     0 1   my $self=$_[0];
111 0           my $object=$_[1];
112              
113 0 0         if ( !defined( $object ) ){
114 0           return 0;
115             }
116              
117 0 0         if ( ref( $object ) ne 'Proc::ProcessTable::Process' ){
118 0           return 0;
119             }
120              
121 0           my $proc_pctcpu;
122 0           eval{
123 0           $proc_pctcpu=$object->pctcpu;
124             };
125              
126             # don't bother proceeding, the object won't match ever
127             # as it does not have a PctCPU
128 0 0         if ( ! defined( $proc_pctcpu ) ){
129 0           return 0;
130             }
131              
132             # use while as foreach will reference the value
133 0           my $pctcpu_int=0;
134 0           while (defined( $self->{pctcpus}[$pctcpu_int] )){
135 0           my $pctcpu=$self->{pctcpus}[$pctcpu_int];
136 0 0 0       if (
    0          
    0          
    0          
    0          
    0          
137             ( $pctcpu =~ /^[0-9.]+$/ ) &&
138             ( $pctcpu eq $proc_pctcpu )
139             ){
140 0           return 1;
141             }elsif( $pctcpu =~ /^\<\=[0-9.]+$/ ){
142 0           $pctcpu=~s/^\<\=//;
143 0 0         if ( $proc_pctcpu <= $pctcpu ){
144 0           return 1;
145             }
146             }elsif( $pctcpu =~ /^\<[0-9.]+$/ ){
147 0           $pctcpu=~s/^\
148 0 0         if ( $proc_pctcpu < $pctcpu ){
149 0           return 1;
150             }
151             }elsif( $pctcpu =~ /^\>\=[0-9.]+$/ ){
152 0           $pctcpu=~s/^\>\=//;
153 0 0         if ( $proc_pctcpu >= $pctcpu ){
154 0           return 1;
155             }
156             }elsif( $pctcpu =~ /^\>[0-9.]+$/ ){
157 0           $pctcpu=~s/^\>//;
158 0 0         if ( $proc_pctcpu > $pctcpu ){
159 0           return 1;
160             }
161             }elsif( $pctcpu =~ /^\![0-9.]+$/ ){
162 0           $pctcpu=~s/^\!//;
163 0 0         if ( $proc_pctcpu ne $pctcpu ){
164 0           return 1;
165             }
166             }
167 0           $pctcpu_int++;
168             }
169              
170 0           return 0;
171             }
172              
173             =head1 AUTHOR
174              
175             Zane C. Bowers-Hadley, C<< >>
176              
177             =head1 BUGS
178              
179             Please report any bugs or feature requests to C, or through
180             the web interface at L. I will be notified, and then you'll
181             automatically be notified of progress on your bug as I make changes.
182              
183              
184              
185              
186             =head1 SUPPORT
187              
188             You can find documentation for this module with the perldoc command.
189              
190             perldoc Proc::ProcessTable::Match
191              
192              
193             You can also look for information at:
194              
195             =over 4
196              
197             =item * RT: CPAN's request tracker (report bugs here)
198              
199             L
200              
201             =item * AnnoCPAN: Annotated CPAN documentation
202              
203             L
204              
205             =item * CPAN Ratings
206              
207             L
208              
209             =item * Search CPAN
210              
211             L
212              
213             =back
214              
215              
216             =head1 ACKNOWLEDGEMENTS
217              
218              
219             =head1 LICENSE AND COPYRIGHT
220              
221             Copyright 2019 Zane C. Bowers-Hadley.
222              
223             This program is free software; you can redistribute it and/or modify it
224             under the terms of the the Artistic License (2.0). You may obtain a
225             copy of the full license at:
226              
227             L
228              
229             Any use, modification, and distribution of the Standard or Modified
230             Versions is governed by this Artistic License. By using, modifying or
231             distributing the Package, you accept this license. Do not use, modify,
232             or distribute the Package, if you do not accept this license.
233              
234             If your Modified Version has been derived from a Modified Version made
235             by someone other than you, you are nevertheless required to ensure that
236             your Modified Version complies with the requirements of this license.
237              
238             This license does not grant you the right to use any trademark, service
239             mark, tradename, or logo of the Copyright Holder.
240              
241             This license includes the non-exclusive, worldwide, free-of-charge
242             patent license to make, have made, use, offer to sell, sell, import and
243             otherwise transfer the Package with respect to any patent claims
244             licensable by the Copyright Holder that are necessarily infringed by the
245             Package. If you institute patent litigation (including a cross-claim or
246             counterclaim) against any party alleging that the Package constitutes
247             direct or contributory patent infringement, then this Artistic License
248             to you shall terminate on the date that such litigation is filed.
249              
250             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
251             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
252             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
253             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
254             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
255             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
256             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
257             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
258              
259              
260             =cut
261              
262             1; # End of Proc::ProcessTable::Match