File Coverage

blib/lib/App/JIRAPrint.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


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.001';
4 6     6   151216 use Moose;
  0            
  0            
5             use Log::Any qw/$log/;
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
28              
29             =cut
30              
31             use autodie qw/:all/;
32             use Cwd;
33             use Data::Dumper;
34             use File::Spec;
35             use Hash::Merge;
36             use JIRA::REST;
37             use LaTeX::Encode;
38             use Template;
39              
40             BEGIN{
41             # The test compatible File::Share
42             eval{ require File::Share; File::Share->import('dist_dir'); };
43             if( $@ ){
44             # The production only File::ShareDir
45             require File::ShareDir;
46             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             my ($self) = @_;
78             $log->info("Accessing JIRA At ".$self->url()." as '".$self->username()."' (+password)");
79             return JIRA::REST->new( $self->url() , $self->username() , $self->password() );
80             }
81              
82             sub _build_fields{
83             my ($self) = @_;
84             return $self->config()->{fields} // [ qw/key status summary assignee/ ];
85             }
86              
87             sub _build_maxissues{
88             my ($self) = @_;
89             return $self->config()->{maxissues} // 50;
90             }
91              
92             sub _build_url{
93             my ($self) = @_;
94             return $self->config()->{url} // die "Missing url ".$self->config_place()."\n";
95             }
96              
97             sub _build_username{
98             my ($self) = @_;
99             return $self->config()->{username} // die "Missing username ".$self->config_place()."\n";
100             }
101              
102             sub _build_password{
103             my ($self) = @_;
104             return $self->config()->{password} // die "Missing password ".$self->config_place()."\n";
105             }
106              
107             sub _build_project{
108             my ($self) = @_;
109             return $self->config()->{project} // die "Missing project ".$self->config_place()."\n";
110             }
111              
112             sub _build_sprint{
113             my ($self) = @_;
114             return $self->config()->{sprint} // die "Missing sprint ".$self->config_place()."\n";
115             }
116              
117             sub _build_jql{
118             my ($self) = @_;
119             return $self->config()->{jql} //
120             'project = "'.$self->project().'" and Sprint = "'.$self->sprint().'" ORDER BY status, assignee, created'
121             }
122              
123             sub _build_template_file{
124             my ($self) = @_;
125             return $self->config()->{template_file} //
126             File::Spec->catfile( $self->shared_directory() , 'std_tickets.tex.tt' );
127             }
128              
129             sub config_place{
130             my ($self) = @_;
131             if( $self->has_config_files() && @{ $self->config_files() } ){
132             return 'in config files: '.join(', ', @{$self->config_files()} );
133             }
134             return 'in memory config';
135             }
136              
137             sub _build_config{
138             my ($self) = @_;
139             my $config = {};
140             my $merge = Hash::Merge->new( 'RIGHT_PRECEDENT' );
141             foreach my $config_file ( @{$self->config_files} ){
142             $log->info("Loading $config_file");
143             my $file_config = do $config_file ;
144             unless( $file_config ){
145             $log->warn("Cannot read $config_file");
146             $file_config = {};
147             }
148             $config = $merge->merge( $config, $file_config );
149             }
150             return $config;
151             }
152              
153             sub _build_config_files{
154             my ($self) = @_;
155             my @candidates = (
156             File::Spec->catfile( '/' , 'etc' , 'jiraprint.conf' ),
157             File::Spec->catfile( $ENV{HOME} , '.jiraprint.conf' ),
158             File::Spec->catfile( getcwd() , '.jiraprint.conf' ),
159             );
160             my @files = ();
161             foreach my $candidate ( @candidates ){
162             $log->debug("Looking for $candidate");
163             if( -r $candidate ){
164             $log->info("Found config file '$candidate'");
165             push @files , $candidate;
166             }
167             }
168             unless( @files ){
169             $log->warn("Cannot find any config files amongst ".join(', ' , @candidates ).". Relying only on command line switches");
170             }
171             return \@files;
172             }
173              
174             sub _build_shared_directory{
175             my ($self) = @_;
176             my $file_based_dir = File::Spec->rel2abs(__FILE__);
177             $file_based_dir =~ s|lib/App/JIRAPrint.+||;
178             $file_based_dir .= 'share/';
179             if( -d $file_based_dir ){
180             my $real_sharedir = Cwd::realpath($file_based_dir);
181             unless( $real_sharedir ){
182             confess("Could not build Cwd::realpath from '$file_based_dir'");
183             }
184             $real_sharedir .= '/';
185              
186             $log->debug("Will use file based shared directory '$real_sharedir'");
187             return $real_sharedir;
188             }
189              
190             my $dist_based_dir = Cwd::realpath(dist_dir('App-JIRAPrint'));
191              
192             my $real_sharedir = Cwd::realpath($dist_based_dir);
193             unless( $real_sharedir ){
194             confess("Could not build Cwd::realpath from '$dist_based_dir'");
195             }
196              
197             $real_sharedir .= '/';
198              
199             $log->debug("Will use directory ".$real_sharedir);
200             return $real_sharedir;
201             }
202              
203             sub _build_tt{
204             my ($self) = @_;
205             return Template->new({
206             STRICT => 1,
207             FILTERS => {
208             tex => sub{
209             my ($text) = @_;
210             return LaTeX::Encode::latex_encode($text);
211             }
212             }
213             });
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             my ($self) = @_;
225             my $stash = $self->fetch_issues();
226              
227             my $fio = IO::File->new($self->template_file(), "r");
228             my $output = '';
229             $self->tt()->process( $fio , $stash , \$output ) || die $self->tt()->error();
230             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             my ($self) = @_;
245             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             my ($self) = @_;
260             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             (sub{
269             return "Issues ".( Data::Dumper->new([ $issues ])->Indent(0)->Terse(1)->Deparse(1)->Sortkeys(1)->Dump );
270             })
271             }() ) if $log->is_debug();
272             foreach my $issue ( @{$issues->{issues}} ){
273             $issue->{url} = $self->url().'/browse/'.$issue->{key};
274             }
275             return $issues;
276             }
277              
278             1;