File Coverage

blib/lib/Redmine/Stat.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Redmine::Stat;
2              
3 1     1   163024 use strict;
  1         3  
  1         48  
4 1     1   7 use warnings;
  1         2  
  1         42  
5 1     1   1252 use utf8;
  1         16  
  1         6  
6              
7             require Crypt::SSLeay;
8             require IO::Socket::SSL;
9 1     1   1501 use Carp;
  1         2  
  1         89  
10 1     1   1228 use LWP::UserAgent;
  1         75604  
  1         38  
11 1     1   550 use XML::LibXML;
  0            
  0            
12              
13              
14             our $redmine_url;
15             our $xml_auth_key;
16             our $xml_query_id;
17             our $xml;
18             our $xml_type;
19             our %projects;
20             our %trackers;
21              
22             our $total_issues;
23              
24             our $VERSION = '0.01';
25              
26             # Below is stub documentation for your module. You'd better edit it!
27              
28             =head1 NAME
29              
30             Redmine::Stat - Perl extension for dealing with Redmine Rest api.
31              
32             =head1 SYNOPSIS
33              
34             use Redmine::Stat;
35             my $redmine = new Redmine::Stat;
36              
37             $redmine->auth_key('your_secret_key_to_api');
38             $redmine->url('https://your.redmine.url');
39             $redmine->query_id(100500) #id of redmine query, which stats your are gathering
40              
41              
42             use Redmine::Stat;
43             my $redmine = new Redmine::Stat->new(
44             auth_key => 'your_secret_key_to_api',
45             url => 'https://your.redmine.url');
46             query_id => 100500,
47             );
48              
49              
50              
51             $redmine->query(); #this does all the work
52              
53             $issues_count = $redmine->total_issues;
54             $projects_count = $redmine->total_projects;
55             $trackers_count = $redmine->total_trackers;
56              
57             foreach ($redmine->projects)
58             {
59             print "Project: ". $_->{name} . " ";
60             print "Path: ". $_->{redmine_path} ." ";
61             print "Descripttion: ". $_->{description} ." ";
62             print "Issues count: ". $_->{issues_count} ." ";
63             print "\r\n";
64             }
65              
66             foreach ($redmine->trackers)
67             {
68             print "Tracker: ". $_->{name} ." ";
69             print "Issues count: ". $_->{issues_count} ." ";
70             print "\r\n";
71             }
72              
73             $trackers{bug} = $redmine->tracker('BUG'); #you can search trackers by name
74             $trackers{feature} = $remdine->tracker(4); #or by redmine id
75              
76             $projects{test.com} = $redmine->project('test.com'); #projects by name
77             $projects{test.org} = $redmine->project(15); #by id
78             $projects{test.net} = $redmine->project('test_net') #by redmine project path
79              
80              
81              
82             =head1 DESCRIPTION
83              
84             This module is designed for statistic purposes only, it does not apply CRUD or any other operations. I have wrote this module because i wanted to combine RRDtool with my Redmine.
85              
86             Redmine::Stat works with Redmine REST api (L). By default redmine forces clients to use pagination, and does not allow unlimited queries, what is a bad idea imho. You need some modifications in Redmine core for this module to work correctly. Otherwise, if you don't need by-project or by-tracker issue statistics, you may not modify Redmine - this module will deal with "meta" fields, such as total_count. Maximum limit (100) is located as a Magick number in B as of my version B<1.4.2>.
87              
88             You may get almost any statistics by creating your own queries in redmine, and parsing them through this module.
89              
90              
91             =head1 SEE ALSO
92              
93             =over
94              
95             =item Redmine REST api L
96              
97             =item L
98              
99             =back
100              
101             =head1 AUTHOR
102              
103             Fedor A Borshev, Efedor@shogo.ruE
104              
105              
106              
107             =head1 COPYRIGHT AND LICENSE
108              
109             Copyright (C) 2012 by Fedor A Borshev
110              
111             This library is free software; you can redistribute it and/or modify
112             it under the same terms as Perl itself, either Perl version 5.10.1 or,
113             at your option, any later version of Perl 5 you may have available.
114              
115             =cut
116              
117             sub new
118             {
119             (my $self, my %p) = @_;
120              
121             $self->url ($p{url}) if exists $p{url} and length $p{url};
122             $self->auth_key ($p{auth_key}) if exists $p{auth_key} and length $p{auth_key};
123             $self->query_id ($p{query_id}) if exists $p{query_id} and length $p{query_id};
124             $self;
125             }
126              
127              
128             sub query
129             {
130             my $self = shift;
131              
132             $self->xml_type('issues');
133             $self->_parse_xml(
134             $self->_get_xml( $self->_get_query_url('issues') )
135             ) or confess 'Cannot parse issues xml:(';
136              
137             $self->_parse_projects();
138             $self->_parse_trackers();
139              
140             $total_issues = $self->total_issues;
141              
142             $self->xml_type('projects');
143             $self->_parse_xml(
144             $self->_get_xml( $self->_get_query_url('projects') )
145             ) or confess 'Cannot parse projects xml:(';
146              
147             $self->_parse_projects();
148              
149             $self->xml_type('trackers');
150             $self->_parse_xml(
151             $self->_get_xml( $self->_get_query_url('trackers') )
152             ) or confess 'Cannot parse trackers xml:(';
153            
154              
155             $self->_parse_trackers();
156              
157             }
158              
159             sub total_issues
160             {
161             my $self=shift;
162              
163             return $self->_total if $self->xml_type eq 'issues';
164              
165             return $total_issues;
166             }
167              
168             sub total_projects
169             {
170             my $self=shift;
171            
172             if ( $self->xml_type eq 'projects' )
173             {
174             return $self->_total;
175             }
176            
177             if( $self->xml_type eq 'issues' ) #count of projects in issues query
178             {
179             $self->_parse_projects;
180             return scalar keys %projects;
181             }
182              
183             return scalar keys %projects;
184              
185             }
186              
187             sub total_trackers
188             {
189             my $self = shift;
190              
191             if( $self->xml_type eq 'trackers' )
192             {
193             $self->_parse_trackers;
194             return scalar keys %trackers;
195             }
196             return scalar keys %trackers;
197             }
198              
199             sub issues_by_tracker
200             {
201             (my $self, my $tracker) = @_;
202            
203             return $self->_count_issues('tracker', $tracker);
204             }
205              
206             sub issues_by_author
207             {
208             (my $self, my $author) = @_;
209              
210             return $self->_count_issues('author', $author);
211              
212             }
213              
214             sub issues_by_status
215             {
216             (my $self, my $status) = @_;
217            
218             return $self->_count_issues('status', $status);
219              
220             }
221              
222             sub issues_by_project
223             {
224             (my $self, my $project) = @_;
225              
226             return $self->_count_issues('project', $project);
227             }
228              
229              
230              
231             sub _parse_xml
232             {
233            
234             (my $self, my $data) = @_;
235              
236             confess "Bad XML data" if not $data or not length $data;
237              
238             $xml = XML::LibXML->load_xml( string => $data ) or confess "Cannot parse XML!";
239              
240              
241             }
242              
243             sub xml_type
244             {
245             (my $self, my $type) = @_;
246              
247             return $xml_type if ( not $type or not length $type );
248              
249             $xml_type = $type;
250             }
251              
252             sub auth_key
253             {
254             (my $self, my $auth_key) = @_;
255            
256             return $xml_auth_key if ( not $auth_key or not length $auth_key );
257              
258             $xml_auth_key = $auth_key;
259             }
260              
261             sub query_id
262             {
263             (my $self, my $query_id) = @_;
264              
265             return $xml_query_id if ( not $query_id or not length $query_id );
266              
267             $xml_query_id = $query_id;
268             }
269              
270             sub url
271             {
272             (my $self, my $url) = @_;
273              
274             return $redmine_url if ( not $url or not length $url );
275            
276              
277             $url =~ s/\/$//;
278              
279             $redmine_url = $url;
280             }
281              
282              
283             sub raw_xml
284             {
285             my $self = shift;
286            
287             return $xml;
288              
289             }
290              
291             sub project
292             {
293             (my $self, my $prj) = @_;
294              
295             if( $prj =~ /^\d+$/ and exists $projects{$prj} )
296             {
297              
298             return $projects{$prj};
299             }
300              
301             chomp $prj;
302              
303             foreach (keys %projects)
304             {
305             return $projects{$_} if( exists $projects{$_} and $projects{$_}{name} eq $prj );
306             return $projects{$_} if( exists $projects{$_} and exists $projects{$_}{redmine_path} and $projects{$_}{redmine_path} eq $prj );
307             }
308             }
309              
310             sub projects
311             {
312             my $self = shift;
313              
314             return keys %projects;
315             }
316              
317             sub tracker
318             {
319             (my $self, my $tracker) = @_;
320            
321             if( $tracker =~ /^\d+$/ and exists $trackers{$tracker})
322             {
323             return $trackers{$tracker};
324             }
325              
326             foreach (keys %trackers)
327             {
328             return $trackers{$_} if( exists $trackers{$_} and $trackers{$_}{name} eq $tracker );
329             }
330             }
331              
332             sub trackers
333             {
334             my $self = shift;
335              
336             return keys %trackers;
337             }
338              
339             sub _parse_projects
340             {
341             my $self = shift;
342            
343             if($self->xml_type() eq 'projects')
344             {
345             foreach( $xml->findnodes('projects/project') )
346             {
347             my $id = $_->findvalue('id');
348              
349             $projects{$id}{name} = $_->findvalue('name');
350             $projects{$id}{redmine_path} = $_->findvalue('identifier');
351             $projects{$id}{description} = $_->findvalue('description') ? $_->findvalue('description') : '';
352              
353             chomp $projects{$id}{description};
354            
355             }
356             }
357             if($self->xml_type() eq 'issues')
358             {
359             foreach( $xml->findnodes('issues/issue') )
360             {
361             (my $prj_node) = $_->findnodes ('project');
362              
363             my $id = $prj_node->getAttribute('id');
364             my $name = $prj_node->getAttribute('name');
365              
366             $projects{$id}{name} = $name;
367             }
368              
369             $self->_count_issues_by_project;
370             }
371             }
372              
373             sub _count_issues_by_project
374             {
375             my $self=shift;
376              
377             if($self->xml_type() eq 'issues')
378             {
379             foreach( keys %projects)
380             {
381             $projects{$_}{issues_count}=$self->_count_issues('project',$_);
382             }
383             }
384             }
385              
386             sub _count_issues_by_tracker
387             {
388             my $self=shift;
389              
390             if($self->xml_type() eq 'issues')
391             {
392             foreach( keys %trackers)
393             {
394             $trackers{$_}{issues_count}=$self->_count_issues('tracker',$_);
395             }
396             }
397             }
398              
399             sub _parse_trackers
400             {
401             my $self = shift;
402              
403             if( $self->xml_type eq 'trackers')
404             {
405             foreach( $xml->findnodes('trackers/tracker') )
406             {
407             my $id = $_->findvalue('id');
408              
409             $trackers{$id}{name} = $_->findvalue('name');
410             }
411             }
412              
413             if( $self->xml_type eq 'issues')
414             {
415             foreach( $xml->findnodes('issues/issue') )
416             {
417             (my $tracker_node) = $_->findnodes ('tracker');
418              
419             my $id = $tracker_node->getAttribute('id');
420             my $name = $tracker_node->getAttribute('name');
421              
422             $trackers{$id}{name} = $name;
423             }
424             $self->_count_issues_by_tracker;
425             }
426              
427             }
428            
429             sub _count_issues
430             {
431             (my $self, my $nodename, my $name_or_id) = @_;
432              
433             my $cnt=0;
434              
435             foreach( $xml->findnodes('issues/issue') )
436             {
437             (my $node) = $_->findnodes( $nodename );
438              
439             if( $name_or_id =~ /^\d+$/ )
440             {
441             $cnt++ if ( $node->getAttribute('id') == $name_or_id );
442             }
443             else
444             {
445             $cnt++ if ( $node->getAttribute('name') eq $name_or_id );
446             }
447             }
448             return $cnt;
449             }
450              
451             sub _total
452             {
453             my $self = shift;
454              
455             my $rootNode=$xml->documentElement;
456              
457             return $rootNode->getAttribute('total_count');
458             }
459              
460             sub _get_query_url
461             {
462             (my $self, my $url_type) = @_;
463              
464             if( $url_type eq 'issues')
465             {
466             return $self->url.'/issues.xml?query_id='.$self->query_id if $self->query_id;
467             return $self->url.'/issues.xml';
468             }
469             return $self->url.'/projects.xml' if( $url_type eq 'projects');
470             return $self->url.'/trackers.xml' if( $url_type eq 'trackers');
471              
472             return $self->url;
473             }
474              
475             sub _get_xml
476             {
477             (my $self, my $url) = @_;
478              
479             my $ua=LWP::UserAgent->new();
480              
481             $ua->default_header(
482             'X-Redmine-API-Key' => $self->auth_key,
483             );
484              
485             my $response=$ua->get($url);
486             confess "Cannot fetch xml data" if $response->is_error;
487            
488             return $response->content;
489              
490             }
491             1;