File Coverage

blib/lib/Proc/ProcessTable/Match/PctMem.pm
Criterion Covered Total %
statement 8 61 13.1
branch 0 40 0.0
condition 0 3 0.0
subroutine 3 5 60.0
pod 2 2 100.0
total 13 111 11.7


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