File Coverage

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