File Coverage

blib/lib/Path/Iterator/Rule/RT.pm
Criterion Covered Total %
statement 25 76 32.8
branch 2 26 7.6
condition 0 3 0.0
subroutine 8 22 36.3
pod 5 5 100.0
total 40 132 30.3


line stmt bran cond sub pod time code
1             package Path::Iterator::Rule::RT;
2              
3 1     1   23515 use 5.0100;
  1         5  
  1         39  
4 1     1   7 use strict;
  1         2  
  1         40  
5 1     1   6 use warnings FATAL => 'all';
  1         7  
  1         50  
6              
7 1     1   1060 use Path::Iterator::Rule;
  1         15546  
  1         36  
8 1     1   2692 use Error qw(:try);
  1         11917  
  1         7  
9 1     1   2068 use RT::Client::REST;
  1         141280  
  1         36  
10 1     1   894 use RT::Client::REST::Ticket;
  1         250979  
  1         1233  
11              
12             my $config_file = $ENV{HOME} . "/.rtrc";
13              
14             my $config;
15              
16             my $rt;
17              
18             sub import {
19 1     1   11 my $package = shift;
20 1 50       11 if (@_ % 2) {
21 0         0 die "${package}::import expects an even number of arguments, if any";
22             }
23 1         3 my %args = @_;
24 1 50       13 if ($args{config_file}) {
25 0           $config_file = $args{config_file};
26             }
27             }
28              
29             # lazy builder for the RT client in $rt and the configuration in $config
30             sub _rt {
31 0 0   0     unless ($rt) {
32 0           $config = parse_config_file( $config_file );
33              
34 0           my ( $username, $password, $server ) =
35             ( $config->{user}, $config->{passwd}, $config->{server} );
36              
37 0           $rt = RT::Client::REST->new(
38             server => $server,
39             timeout => 30,
40             );
41              
42             try {
43 0     0     $rt->login( username => $username, password => $password );
44             }
45             catch Exception::Class::Base with {
46 0     0     die "problem logging in: ", shift->message;
47 0           };
48             }
49              
50 0           return $rt;
51             }
52              
53             Path::Iterator::Rule->add_helper(
54             "status" => sub {
55             my $status = shift;
56             return sub {
57             my ( $item, $basename ) = @_;
58             return check_status( $basename, $status );
59             }
60             }
61             );
62              
63             Path::Iterator::Rule->add_helper(
64             "owner" => sub {
65             my $owner = shift;
66             return sub {
67             my ( $item, $basename ) = @_;
68             return check_owner( $basename, $owner );
69             }
70             }
71             );
72              
73             Path::Iterator::Rule->add_helper(
74             "TicketSQL" => sub {
75             my $TicketSQL = shift;
76             return sub {
77             my ( $item, $basename ) = @_;
78             return check_ticketSQL( $basename, $TicketSQL );
79             }
80             }
81             );
82              
83             =head1 NAME
84              
85             Path::Iterator::Rule::RT - Extends Path::Iterator::Rule with custom rule subroutines that make it easy to add RT ticket data as rules.
86              
87             =head1 VERSION
88              
89             Version 0.05
90              
91             =cut
92              
93             our $VERSION = '0.05';
94              
95             =head1 SYNOPSIS
96              
97             use Path::Iterator::Rule::RT;
98              
99             my $rule = Path::Iterator::Rule->new;
100             $rule->status("resolved");
101             for my $file ( $rule->all(@ARGV) ) {
102             say $file;
103             }
104              
105              
106             my $rule = Path::Iterator::Rule->new;
107             $rule->and(
108             $rule->new->status("new"),
109             $rule->new->owner("Nobody"),
110             );
111             for my $file ( $rule->all(@ARGV) ) {
112             say $file;
113             }
114              
115             =head1 SUBROUTINES/METHODS
116              
117             =head2 check_owner
118              
119             $rule->owner("Nobody");
120              
121             =cut
122              
123             sub check_owner {
124 0     0 1   my ( $id, $owner ) = @_;
125 0 0         return unless $id =~ m/^\d+$/;
126 0           my $ticket;
127             try {
128 0     0     $ticket = RT::Client::REST::Ticket->new(
129             rt => _rt(),
130             id => $id,
131             )->retrieve;
132             }
133             catch Exception::Class::Base with {
134 0     0     return;
135 0           };
136 0 0         return unless $ticket;
137 0           return $owner eq $ticket->owner;
138             }
139              
140             =head2 check_subject
141              
142             $rule->subject("Foo");
143              
144             =cut
145              
146             sub check_subject{
147 0     0 1   my ( $id, $subject) = @_;
148 0 0         return unless $id =~ m/^\d+$/;
149 0           my $ticket;
150             try {
151 0     0     $ticket = RT::Client::REST::Ticket->new(
152             rt => _rt(),
153             id => $id,
154             )->retrieve;
155             }
156             catch Exception::Class::Base with {
157 0     0     return;
158 0           };
159 0 0         return unless $ticket;
160 0           return $subject eq $ticket->subject;
161             }
162              
163             =head2 check_status
164              
165             $rule->status("resolved");
166              
167             =cut
168              
169             sub check_status {
170 0     0 1   my ( $id, $status ) = @_;
171 0 0         return unless $id =~ m/^\d+$/;
172 0           my $ticket;
173             try {
174 0     0     $ticket = RT::Client::REST::Ticket->new(
175             rt => _rt(),
176             id => $id,
177             )->retrieve;
178             }
179             catch Exception::Class::Base with {
180 0     0     return;
181 0           };
182 0 0         return unless $ticket;
183 0           return $status eq $ticket->status;
184             }
185              
186             =head2 check_ticketSQL
187              
188             $rule->TicketSQL("Queue='General' AND Created = 'yesterday'");
189              
190             The TicketSQL is not as it appears. It has id= added to it. So
191              
192             this
193              
194             $rule->TicketSQL("Queue='General' AND Created = 'yesterday'");
195              
196             becomes
197              
198             "id= AND Queue='General' AND Created = 'yesterday'"
199              
200             =cut
201              
202             sub check_ticketSQL {
203 0     0 1   my ( $id, $TicketSQL ) = @_;
204 0 0         return unless $id =~ m/^\d+$/;
205 0           my $query = "id=$id AND ";
206 0           $query .= $TicketSQL;
207              
208 0           my @ids = rt()->search(
209             type => 'ticket',
210             query => $query,
211             );
212 0           return scalar @ids == 1;
213             }
214              
215             =head2 parse_config_file
216              
217             NOTE: This code is a slightly modified version of RT::Client::CLI::parse_config_file.
218              
219             =cut
220              
221             sub parse_config_file {
222 0     0 1   my %cfg;
223 0           my ($file) = @_;
224 0           local $_;
225              
226 0 0         open( my $handle, '<', $file ) or die "Error opening '$file' for reading: $!";
227              
228 0           while (<$handle>) {
229 0           chomp;
230 0 0 0       next if ( /^#/ || /^\s*$/ );
231              
232 0 0         if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/)
233             {
234 0           $cfg{$1} = $2;
235             }
236             else {
237 0           die "rt: $file:$.: unknown configuration directive.\n";
238             }
239             }
240              
241 0           return \%cfg;
242             }
243              
244             =head1 IMPORT
245              
246             By default this module searches for RT client configuration in F<$HOME/.rtrc>
247              
248             You can override the location by importing the module like so
249              
250             use Path::Iterator::Rule::RT config_file => '/path/to/config/file';
251              
252              
253             =head1 AUTHOR
254              
255             Robert Blackwell, C<< >>
256              
257             =head1 BUGS
258              
259             Please report any bugs or feature requests to C, or through
260             the web interface at L. I will be notified, and then you'll
261             automatically be notified of progress on your bug as I make changes.
262              
263              
264             =head2 Source Code
265              
266             This is open source software. The code repository is available for
267             public review and contribution under the terms of the license.
268              
269             L
270              
271             git clone https://github.com/rblackwe/Path-Iterator-Rule-RT.git
272              
273              
274             =head1 SUPPORT
275              
276             You can find documentation for this module with the perldoc command.
277              
278             perldoc Path::Iterator::Rule::RT
279              
280              
281             You can also look for information at:
282              
283             =over 4
284              
285             =item * RT: CPAN's request tracker (report bugs here)
286              
287             L
288              
289             =item * AnnoCPAN: Annotated CPAN documentation
290              
291             L
292              
293             =item * CPAN Ratings
294              
295             L
296              
297             =item * Search CPAN
298              
299             L
300              
301             =back
302              
303              
304             =head1 ACKNOWLEDGEMENTS
305              
306              
307             =head1 LICENSE AND COPYRIGHT
308              
309             Copyright 2014 Robert Blackwell.
310              
311             This program is free software; you can redistribute it and/or modify it
312             under the terms of the the Artistic License (2.0). You may obtain a
313             copy of the full license at:
314              
315             L
316              
317             Any use, modification, and distribution of the Standard or Modified
318             Versions is governed by this Artistic License. By using, modifying or
319             distributing the Package, you accept this license. Do not use, modify,
320             or distribute the Package, if you do not accept this license.
321              
322             If your Modified Version has been derived from a Modified Version made
323             by someone other than you, you are nevertheless required to ensure that
324             your Modified Version complies with the requirements of this license.
325              
326             This license does not grant you the right to use any trademark, service
327             mark, tradename, or logo of the Copyright Holder.
328              
329             This license includes the non-exclusive, worldwide, free-of-charge
330             patent license to make, have made, use, offer to sell, sell, import and
331             otherwise transfer the Package with respect to any patent claims
332             licensable by the Copyright Holder that are necessarily infringed by the
333             Package. If you institute patent litigation (including a cross-claim or
334             counterclaim) against any party alleging that the Package constitutes
335             direct or contributory patent infringement, then this Artistic License
336             to you shall terminate on the date that such litigation is filed.
337              
338             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
339             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
340             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
341             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
342             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
343             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
344             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
345             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
346              
347              
348             =cut
349              
350             1; # End of Path::Iterator::Rule::RT