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