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