File Coverage

blib/lib/App/JIRAPrint.pm
Criterion Covered Total %
statement 114 128 89.0
branch 10 20 50.0
condition 13 23 56.5
subroutine 31 32 96.8
pod 3 4 75.0
total 171 207 82.6


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