File Coverage

blib/lib/App/JIRAPrint.pm
Criterion Covered Total %
statement 111 125 88.8
branch 10 20 50.0
condition 13 23 56.5
subroutine 30 31 96.7
pod 3 4 75.0
total 167 203 82.2


line stmt bran cond sub pod time code
1             package App::JIRAPrint;
2             # ABSTRACT: Print JIRA Tickets on Postit sheets
3             $App::JIRAPrint::VERSION = '0.002';
4 6     6   153504 use Moose;
  6         2978648  
  6         39  
5 6     6   873941 use Log::Any qw/$log/;
  6         1216241  
  6         33  
6              
7             =head1 NAME
8              
9             App::JIRAPrint - Print JIRA Tickets on PostIt sheets
10              
11             =head1 INSTALLATION
12              
13             On system perl:
14              
15             cpan -i App::JIRAPrint
16              
17             Or in your favourite cpan minus place:
18              
19             cpanm App::JIRAPrint
20              
21             =head1 SYNOPSIS
22              
23             jiraprint --help
24              
25             =head1 BUILDING
26              
27             =for HTML <a href="https://travis-ci.org/jeteve/App-JIRAPrint"><img src="https://travis-ci.org/jeteve/App-JIRAPrint.svg?branch=master"></a>
28              
29             =cut
30              
31 6     6   57992 use autodie qw/:all/;
  6         111976  
  6         35  
32 6     6   174703 use Cwd;
  6         14  
  6         458  
33 6     6   40 use Data::Dumper;
  6         13  
  6         300  
34 6     6   35 use File::Spec;
  6         12  
  6         161  
35 6     6   5588 use Hash::Merge;
  6         16267  
  6         350  
36 6     6   4792 use JIRA::REST;
  6         479379  
  6         237  
37 6     6   6790 use LaTeX::Encode;
  6         251019  
  6         45  
38 6     6   91807 use Template;
  6         327141  
  6         622  
39              
40             BEGIN{
41             # The test compatible File::Share
42 6     6   16 eval{ require File::Share; File::Share->import('dist_dir'); };
  6         8809  
  0         0  
43 6 50       49 if( $@ ){
44             # The production only File::ShareDir
45 6         4692 require File::ShareDir;
46 6         51623 File::ShareDir->import('dist_dir');
47             }
48             };
49              
50              
51             # Config stuff.
52             has 'config' => ( is => 'ro', isa => 'HashRef', lazy_build => 1);
53             has 'config_files' => ( is => 'ro' , isa => 'ArrayRef[Str]' , lazy_build => 1);
54              
55             has 'shared_directory' => ( is => 'ro', isa => 'Str', lazy_build => 1);
56             has 'template_file' => ( is => 'ro', isa => 'Str', lazy_build => 1);
57              
58              
59             # Operation properties
60             has 'url' => ( is => 'ro', isa => 'Str', lazy_build => 1 );
61             has 'username' => ( is => 'ro', isa => 'Str' , lazy_build => 1);
62             has 'password' => ( is => 'ro', isa => 'Str' , lazy_build => 1);
63              
64             has 'project' => ( is => 'ro', isa => 'Str' , lazy_build => 1 );
65             has 'sprint' => ( is => 'ro', isa => 'Str' , lazy_build => 1 );
66             has 'maxissues' => ( is => 'ro', isa => 'Int' , lazy_build => 1);
67              
68             has 'jql' => ( is => 'ro', isa => 'Str', lazy_build => 1);
69             has 'fields' => ( is => 'ro', isa => 'ArrayRef[Str]', lazy_build => 1 );
70              
71             # Objects
72             has 'jira' => ( is => 'ro', isa => 'JIRA::REST', lazy_build => 1);
73              
74             has 'tt' => ( is => 'ro', isa => 'Template', lazy_build => 1);
75              
76             sub _build_jira{
77 4     4   12 my ($self) = @_;
78 4         145 $log->info("Accessing JIRA At ".$self->url()." as '".$self->username()."' (+password)");
79 4         251 return JIRA::REST->new( $self->url() , $self->username() , $self->password() );
80             }
81              
82             sub _build_fields{
83 3     3   9 my ($self) = @_;
84 3   100     127 return $self->config()->{fields} // [ qw/key status summary assignee/ ];
85             }
86              
87             sub _build_maxissues{
88 3     3   8 my ($self) = @_;
89 3   100     128 return $self->config()->{maxissues} // 50;
90             }
91              
92             sub _build_url{
93 1     1   2 my ($self) = @_;
94 1   50     33 return $self->config()->{url} // die "Missing url ".$self->config_place()."\n";
95             }
96              
97             sub _build_username{
98 1     1   3 my ($self) = @_;
99 1   50     34 return $self->config()->{username} // die "Missing username ".$self->config_place()."\n";
100             }
101              
102             sub _build_password{
103 1     1   3 my ($self) = @_;
104 1   50     37 return $self->config()->{password} // die "Missing password ".$self->config_place()."\n";
105             }
106              
107             sub _build_project{
108 1     1   2 my ($self) = @_;
109 1   50     58 return $self->config()->{project} // die "Missing project ".$self->config_place()."\n";
110             }
111              
112             sub _build_sprint{
113 1     1   2 my ($self) = @_;
114 1   50     31 return $self->config()->{sprint} // die "Missing sprint ".$self->config_place()."\n";
115             }
116              
117             sub _build_jql{
118 3     3   7 my ($self) = @_;
119             return $self->config()->{jql} //
120 3   33     113 'project = "'.$self->project().'" and Sprint = "'.$self->sprint().'" ORDER BY status, assignee, created'
121             }
122              
123             sub _build_template_file{
124 2     2   4 my ($self) = @_;
125             return $self->config()->{template_file} //
126 2   33     79 File::Spec->catfile( $self->shared_directory() , 'std_tickets.tex.tt' );
127             }
128              
129             sub config_place{
130 2     2 0 2134 my ($self) = @_;
131 2 100 66     82 if( $self->has_config_files() && @{ $self->config_files() } ){
  1         35  
132 1         2 return 'in config files: '.join(', ', @{$self->config_files()} );
  1         33  
133             }
134 1         5 return 'in memory config';
135             }
136              
137             sub _build_config{
138 5     5   14 my ($self) = @_;
139 5         11 my $config = {};
140 5         50 my $merge = Hash::Merge->new( 'RIGHT_PRECEDENT' );
141 5         90 foreach my $config_file ( @{$self->config_files} ){
  5         186  
142 5         145 $log->info("Loading $config_file");
143 5         2241 my $file_config = do $config_file ;
144 5 50       66 unless( $file_config ){
145 0         0 $log->warn("Cannot read $config_file");
146 0         0 $file_config = {};
147             }
148 5         21 $config = $merge->merge( $config, $file_config );
149             }
150 5         485 return $config;
151             }
152              
153             sub _build_config_files{
154 2     2   6 my ($self) = @_;
155             my @candidates = (
156             File::Spec->catfile( '/' , 'etc' , 'jiraprint.conf' ),
157 2         128 File::Spec->catfile( $ENV{HOME} , '.jiraprint.conf' ),
158             File::Spec->catfile( getcwd() , '.jiraprint.conf' ),
159             );
160 2         10 my @files = ();
161 2         7 foreach my $candidate ( @candidates ){
162 6         58 $log->debug("Looking for $candidate");
163 6 50       13287 if( -r $candidate ){
164 0         0 $log->info("Found config file '$candidate'");
165 0         0 push @files , $candidate;
166             }
167             }
168 2 50       25 unless( @files ){
169 2         26 $log->warn("Cannot find any config files amongst ".join(', ' , @candidates ).". Relying only on command line switches");
170             }
171 2         239 return \@files;
172             }
173              
174             sub _build_shared_directory{
175 2     2   5 my ($self) = @_;
176 2         44 my $file_based_dir = File::Spec->rel2abs(__FILE__);
177 2         14 $file_based_dir =~ s|lib/App/JIRAPrint.+||;
178 2         6 $file_based_dir .= 'share/';
179 2 50       65 if( -d $file_based_dir ){
180 0         0 my $real_sharedir = Cwd::realpath($file_based_dir);
181 0 0       0 unless( $real_sharedir ){
182 0         0 confess("Could not build Cwd::realpath from '$file_based_dir'");
183             }
184 0         0 $real_sharedir .= '/';
185              
186 0         0 $log->debug("Will use file based shared directory '$real_sharedir'");
187 0         0 return $real_sharedir;
188             }
189              
190 2         14 my $dist_based_dir = Cwd::realpath(dist_dir('App-JIRAPrint'));
191              
192 2         911 my $real_sharedir = Cwd::realpath($dist_based_dir);
193 2 50       20 unless( $real_sharedir ){
194 0         0 confess("Could not build Cwd::realpath from '$dist_based_dir'");
195             }
196              
197 2         5 $real_sharedir .= '/';
198              
199 2         17 $log->debug("Will use directory ".$real_sharedir);
200 2         128 return $real_sharedir;
201             }
202              
203             sub _build_tt{
204 1     1   3 my ($self) = @_;
205             return Template->new({
206             STRICT => 1,
207             FILTERS => {
208             tex => sub{
209 2     2   52492 my ($text) = @_;
210 2         11 return LaTeX::Encode::latex_encode($text);
211             }
212             }
213 1         34 });
214             }
215              
216              
217             =head2 process_template
218              
219             Processes $this->template_file() with the $this->fetch_issues() and return a string
220              
221             =cut
222              
223             sub process_template{
224 1     1 1 188 my ($self) = @_;
225 1         6 my $stash = $self->fetch_issues();
226              
227 1         47 my $fio = IO::File->new($self->template_file(), "r");
228 1         12335 my $output = '';
229 1 50       54 $self->tt()->process( $fio , $stash , \$output ) || die $self->tt()->error();
230 1         228 return $output;
231             }
232              
233             =head2 fetch_fields
234              
235             Returns the list of available fiels at this (url, username, password, project)
236              
237             Usage:
238              
239             my $fields = $this->fetch_fields();
240              
241             =cut
242              
243             sub fetch_fields{
244 1     1 1 139 my ($self) = @_;
245 1         37 return $self->jira->GET('/field');
246             }
247              
248             =head2 fetch_issues
249              
250             Fetches issues from JIRA Using this object properties (url, username, password, project, maxissues, fields)
251              
252             Usage:
253              
254             my $issues = $this->fetch_issues();
255              
256             =cut
257              
258             sub fetch_issues{
259 2     2 1 149 my ($self) = @_;
260 2         82 my $issues = $self->jira()->POST('/search', undef , {
261             jql => $self->jql(),
262             startAt => 0,
263             maxResults => $self->maxissues(),
264             fields => $self->fields()
265             });
266              
267             $log->debug(&{
268 2 50       49 (sub{
269 0     0   0 return "Issues ".( Data::Dumper->new([ $issues ])->Indent(0)->Terse(1)->Deparse(1)->Sortkeys(1)->Dump );
270             })
271 0         0 }() ) if $log->is_debug();
272 2         34 foreach my $issue ( @{$issues->{issues}} ){
  2         11  
273 2         104 $issue->{url} = $self->url().'/browse/'.$issue->{key};
274             }
275 2         15 return $issues;
276             }
277              
278             1;