File Coverage

blib/lib/Proc/ProcessTable/Match.pm
Criterion Covered Total %
statement 8 78 10.2
branch 0 36 0.0
condition 0 12 0.0
subroutine 3 5 60.0
pod 2 2 100.0
total 13 133 9.7


line stmt bran cond sub pod time code
1             package Proc::ProcessTable::Match;
2              
3 1     1   66947 use 5.006;
  1         4  
4 1     1   6 use strict;
  1         2  
  1         22  
5 1     1   5 use warnings;
  1         2  
  1         750  
6              
7             =head1 NAME
8              
9             Proc::ProcessTable::Match - Matches a Proc::ProcessTable::Process against a stack of checks.
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;
23             use Proc::ProcessTable;
24             use Data::Dumper;
25            
26             # looks for a kernel proc with the PID of 0
27             my %args=(
28             checks=>[
29             {
30             type=>'PID',
31             invert=>0,
32             args=>{
33             pids=>['0'],
34             }
35             },{
36             type=>'KernProc',
37             invert=>0,
38             args=>{
39             }
40             }
41             ]
42             );
43            
44             # hits on every proc but the idle proc
45             %args=(
46             checks=>[
47             {
48             type=>'Idle',
49             invert=>1,
50             args=>{
51             }
52             }
53             ]
54             );
55            
56             my $ppm;
57             eval{
58             $ppm=Proc::ProcessTable::Match->new( \%args );
59             } or die "New failed with...".$@;
60            
61             my $pt = Proc::ProcessTable->new;
62             foreach my $proc ( @{$t->table} ){
63             if ( $ppm->match( $proc ) ){
64             print Dumper( $proc );
65             }
66             }
67              
68             =head1 METHODS
69              
70             =head2 new
71              
72             This ininitates the object.
73              
74             One argument is taken and it is a hashref with the key "checks".
75             That value needs to contains a array of hashs of checks to run.
76              
77             =head3 checks hash
78              
79             Every check must hit for it to beconsidered a match.
80              
81             Each of these should always be defined.
82              
83             =head4 type
84              
85             This is the module to use to use to run the check.
86              
87             The name is relative 'Proc::ProcessTable::Match::', so
88             'PID' becomes 'Proc::ProcessTable::Match::PID'.
89              
90             =head4 invert
91              
92             This inverts inverts the returned value from the check.
93              
94             =head4 args
95              
96             This is a hash that will be pashed to the checker module's
97             new method.
98              
99             For any required keys, check the documents for that checker.
100              
101             If it does not take any arguments, just pass a blank hash.
102              
103             my %args=(
104             checks=>[
105             {
106             type=>'PID',
107             invert=>0,
108             args=>{
109             pids=>['0'],
110             }
111             },{
112             type=>'KernProc',
113             invert=>0,
114             args=>{
115             }
116             }
117             ]
118             );
119            
120             my $ppm;
121             eval{
122             $ppm=Proc::ProcessTable::Match->new( \%args );
123             } or die "New failed with...".$@;
124              
125             =cut
126              
127             sub new{
128 0     0 1   my %args;
129 0 0         if(defined($_[1])){
130 0           %args= %{$_[1]};
  0            
131             };
132              
133             # Provides some basic checks.
134             # Could make these all one if, but this provides more
135             # granularity for some one using it.
136 0 0         if ( ! defined( $args{checks} ) ){
137 0           die ('No check key specified in the argument hash');
138             }
139 0 0         if ( ref( @{ $args{checks} } ) eq 'ARRAY' ){
  0            
140 0           die ('The checks key is not a array');
141             }
142             # Will never match anything.
143 0 0         if ( ! defined $args{checks}[0] ){
144 0           die ('Nothing in the checks array');
145             }
146 0 0         if ( ref( %{ $args{checks}[0] } ) eq 'HASH' ){
  0            
147 0           die ('The first item in the checks array is not a hash');
148             }
149              
150 0           my $self = {
151             checks=>[],
152             };
153 0           bless $self;
154              
155             # will hold the created check objects
156 0           my @checks;
157              
158             # Loads up each check or dies if it fails to.
159 0           my $check_int=0;
160 0           while( defined( $args{checks}[$check_int] ) ){
161 0           my %new_check=(
162             type=>undef,
163             args=>undef,
164             invert=>undef,
165             );
166              
167             # make sure we have a check type
168 0 0         if ( defined($args{checks}[$check_int]{'type'}) ){
169 0           $new_check{type}=$args{checks}[$check_int]{'type'};
170             }else{
171 0           die('No type defined for check '.$check_int);
172             }
173              
174             # does a quick check on the tpye name
175 0           my $type_test=$new_check{type};
176 0           $type_test=~s/[A-Za-z0-9]//g;
177 0           $type_test=~s/\:\://g;
178 0 0         if ( $type_test !~ /^$/ ){
179 0           die 'The type "'.$new_check{type}.'" for check '.$check_int.' is not a valid check name';
180             }
181              
182             # makes sure we have a args object and that it is a hash
183 0 0 0       if (
184             ( defined($args{checks}[$check_int]{'args'}) ) &&
185             ( ref( $args{checks}[$check_int]{'args'} ) eq 'HASH' )
186             ){
187 0           $new_check{args}=$args{checks}[$check_int]{'args'};
188             }else{
189 0           die('No type defined for check '.$check_int.' or it is not a HASH');
190             }
191              
192             # makes sure we have a args object and that it is a hash
193 0 0 0       if (
    0 0        
194             ( defined($args{checks}[$check_int]{'invert'}) ) &&
195             ( ref( \$args{checks}[$check_int]{'invert'} ) ne 'SCALAR' )
196             ){
197 0           die('Invert defined for check '.$check_int.' but it is not a SCALAR');
198             }elsif(
199             ( defined($args{checks}[$check_int]{'invert'}) ) &&
200             ( ref( \$args{checks}[$check_int]{'invert'} ) eq 'SCALAR' )
201             ){
202 0           $new_check{invert}=$args{checks}[$check_int]{'invert'};
203             }
204              
205 0           my $check;
206             my $eval_string='use Proc::ProcessTable::Match::'.$new_check{type}.';'.
207 0           '$check=Proc::ProcessTable::Match::'.$new_check{type}.'->new( $new_check{args} );';
208 0           eval( $eval_string );
209              
210 0 0         if (!defined( $check )){
211 0           die 'Failed to init the check for '.$check_int.' as it returned undef... '.$@;
212             }
213              
214 0           $new_check{check}=$check;
215              
216 0           push(@{ $self->{checks} }, \%new_check );
  0            
217              
218 0           $check_int++;
219             }
220              
221 0 0         if ( $args{testing} ){
222 0           $self->{testing}=1;
223             }
224              
225 0           return $self;
226             }
227              
228             =head2 match
229              
230             Checks if a single Proc::ProcessTable::Process object matches the stack.
231              
232             One object is argument is taken and that is the Net::Connection to check.
233              
234             The return value is a boolean.
235              
236             if ( $ppm->match( $conn ) ){
237             print "It matched.\n";
238             }
239              
240             =cut
241              
242             sub match{
243 0     0 1   my $self=$_[0];
244 0           my $proc=$_[1];
245              
246 0 0 0       if (
247             ( ! defined( $proc ) ) ||
248             ( ref( $proc ) ne 'Proc::ProcessTable::Process' )
249             ){
250 0           $self->{error}=2;
251 0           $self->{errorString}='Either the connection is undefined or is not a Proc::ProcessTable::Process object';
252 0 0         if ( ! $self->{testing} ){
253 0           $self->warn;
254             }
255 0           return undef;
256             }
257              
258             # Stores the number of hits
259 0           my $hits=0;
260 0           my $required=0;
261 0           foreach my $check ( @{ $self->{checks} } ){
  0            
262 0           my $hit;
263 0           eval{
264 0           $hit=$check->{check}->match($proc);
265             };
266              
267             # If $hits is undef, then one of the checks errored and we skip processing the results.
268             # Should only be 0 or 1.
269 0 0         if ( defined( $hit ) ){
270             # invert if needed
271 0 0         if ( $check->{invert} ){
272 0           $hit = $hit ^ 1;
273             }
274              
275             # increment the hits count if we hit
276 0 0         if ( $hit ){
277 0           $hits++;
278             }
279             }
280              
281 0           $required++;
282             }
283              
284             # if these are the same, then we have a match
285 0 0         if ( $required eq $hits ){
286 0           return 1;
287             }
288              
289             # If we get here, it is not a match
290 0           return 0;
291             }
292              
293             =head1 AUTHOR
294              
295             Zane C. Bowers-Hadley, C<< >>
296              
297             =head1 BUGS
298              
299             Please report any bugs or feature requests to C, or through
300             the web interface at L. I will be notified, and then you'll
301             automatically be notified of progress on your bug as I make changes.
302              
303              
304              
305              
306             =head1 SUPPORT
307              
308             You can find documentation for this module with the perldoc command.
309              
310             perldoc Proc::ProcessTable::Match
311              
312              
313             You can also look for information at:
314              
315             =over 4
316              
317             =item * RT: CPAN's request tracker (report bugs here)
318              
319             L
320              
321             =item * AnnoCPAN: Annotated CPAN documentation
322              
323             L
324              
325             =item * CPAN Ratings
326              
327             L
328              
329             =item * Search CPAN
330              
331             L
332              
333             =item * Repository
334              
335             L
336              
337             =back
338              
339              
340             =head1 ACKNOWLEDGEMENTS
341              
342              
343             =head1 LICENSE AND COPYRIGHT
344              
345             This software is Copyright (c) 2019 by Zane C. Bowers-Hadley.
346              
347             This is free software, licensed under:
348              
349             The Artistic License 2.0 (GPL Compatible)
350              
351              
352             =cut
353              
354             1; # End of Proc::ProcessTable::Match