File Coverage

blib/lib/PDF/TableX.pm
Criterion Covered Total %
statement 101 108 93.5
branch 9 16 56.2
condition 2 5 40.0
subroutine 20 21 95.2
pod 8 8 100.0
total 140 158 88.6


line stmt bran cond sub pod time code
1             package PDF::TableX;
2              
3 7     7   1194676 use Moose;
  7         2512796  
  7         65  
4 7     7   57774 use MooseX::Types;
  7         298732  
  7         35  
5 7     7   33564 use MooseX::Types::Moose qw/Int/;
  7         108992  
  7         68  
6              
7 7     7   35742 use Carp;
  7         14  
  7         610  
8 7     7   5088 use PDF::API2;
  7         1427480  
  7         287  
9              
10 7     7   3572 use PDF::TableX::Row;
  7         32  
  7         85  
11 7     7   7799 use PDF::TableX::Column;
  7         30  
  7         84  
12 7     7   3332 use PDF::TableX::Cell;
  7         18  
  7         37  
13              
14             with 'PDF::TableX::Stylable';
15              
16             our $VERSION = '0.015';
17              
18             # public attrs
19             has width => (is => 'rw', isa => 'Num', default => 0);
20             has start_x => (is => 'rw', isa => 'Num', default => 0);
21             has start_y => (is => 'rw', isa => 'Num', default => 0);
22             has rows => (is => 'ro', isa => 'Int', default => 0);
23             has cols => (is => 'ro', isa => 'Int', default => 0);
24             has repeat_header => (is => 'rw', isa => 'Bool', default => 0);
25              
26             # private attrs
27             has _cols => (is => 'ro', init_arg => undef, isa => 'ArrayRef[ Object ]', default => sub {[]});
28              
29             # some sugar
30 7     7   3541 use overload '@{}' => sub { return $_[0]->{_children}; }, fallback => 1;
  7     168   15  
  7         72  
  168         4584  
31              
32             # make some methods
33             for my $attr (qw/width repeat_header/) {
34             around $attr => sub {
35             my $orig = shift;
36             my $self = shift;
37             return $self->$orig() unless @_;
38             $self->$orig(@_);
39             return $self;
40             }
41             }
42              
43             # overridden methods
44             override BUILDARGS => sub {
45             my $class = shift;
46             if (@_ == 2 and Int->check($_[0]) and Int->check($_[1])) {
47             return {
48             cols => $_[0],
49             rows => $_[1],
50             width => 190 / 25.4 *72,
51             start_x => 10 / 25.4 *72,
52             start_y => 287 / 25.4 *72,
53             };
54             }
55             return super;
56             };
57              
58             sub BUILD {
59 6     6 1 16011 my ($self) = @_;
60 6         31 $self->_create_initial_struct;
61             };
62              
63             # private methods
64             sub _create_initial_struct {
65 6     6   18 my ($self) = @_;
66 6 50       187 if ( my $rows = $self->rows ) {
67 6         19 $self->{rows} = 0;
68 6         42 for (0..$rows-1) {
69 34         1017 $self->add_row( PDF::TableX::Row->new(
70             cols => $self->cols,
71             width => $self->width,
72             _row_idx => $_,
73             _parent => $self,
74             $self->properties,
75             )
76             );
77             }
78             }
79             }
80              
81             sub properties {
82 35     35 1 116 my ($self, @attrs) = @_;
83 35 50       240 @attrs = scalar(@attrs) ? @attrs : $self->attributes;
84 35         1453 return (map { $_ => $self->$_ } @attrs);
  350         1493  
85             }
86              
87             sub add_row {
88 34     34 1 628 my ($self, $row) = @_;
89 34         121 $self->{rows}++;
90 34         72 push @{$self->{_children}}, $row;
  34         270  
91             }
92              
93             sub col {
94 46     46 1 110 my ($self, $i) = @_;
95 46 100       324 return $self->{_cols}->[$i] if (defined $self->{_cols}->[$i]);
96 21         190 my $col = PDF::TableX::Column->new();
97 21         41122 for ( @{$self} ) {
  21         90  
98 146         321 $col->add_cell( $_->[$i] );
99             }
100 21         129 $self->{_cols}->[$i] = $col;
101 21         89 return $col;
102             }
103              
104             sub draw {
105 6     6 1 32 my ($self, $pdf, $page, $y, $col_widths) = @_;
106 6         13 my $spanned = 0;
107 6   33     62 $self->{start_y} = $y || $self->{start_y};
108 6         52 $self->_set_col_widths($col_widths);
109             # get gfx, txt page objects in proper order to prevent from background hiding the text
110 6         93 my @states = ($page->gfx, $page->text, $page->gfx, $page->text, $page->gfx, $page->text);
111             ROW:
112 6         8923 for (@{$self->{_children}}) {
  6         38  
113 37         202 my ($row_height, $overflow) = $self->_draw_row( $_, @states );
114 37 100       148 if ( $overflow ) {
115 3         9 $spanned++;
116 3         35 $page = $pdf->page;
117 3         3040 $self->{start_y} = [ $page->get_mediabox ]->[3] - $self->margin->[0];
118 3         20 @states = ($page->gfx, $page->text, $page->gfx, $page->text, $page->gfx, $page->text);
119 3 50       4464 if ( $self->repeat_header ) {
120 3         16 my ($row_height, $overflow) = $self->_draw_row( $self->[0], @states );
121 3         20 $self->{start_y} -= $row_height;
122             }
123 3         17 redo ROW;
124             } else {
125 34         194 $self->{start_y} -= $row_height;
126             }
127             }
128 6         44 return ($page, $spanned, $self->{start_y});
129             }
130              
131             sub _draw_row {
132 40     40   190 my ($self, $row, @states) = @_;
133 40         1144 my ($row_height, $overflow) = $row->draw_content($self->start_x, $self->start_y, $states[4], $states[5] );
134 40         278 $row->height( $row_height );
135 40         1157 $row->draw_background($self->start_x, $self->start_y, $states[0], $states[1]);
136 40         1100 $row->draw_borders($self->start_x, $self->start_y, $states[2], $states[3]);
137 40         240 return ($row_height, $overflow);
138             }
139              
140             sub _set_col_widths {
141 6     6   22 my ($self, $col_widths) = @_;
142            
143 6 0 50     33 if ( defined $col_widths && scalar(@{$col_widths}) ) {
  0         0  
144 0         0 for (0..$self->cols-1) {
145 0         0 $self->col($_)->width( $col_widths->[$_] );
146             }
147 0         0 return;
148             }
149            
150 6         18 my @min_col_widths = ();
151 6         14 my @reg_col_widths = ();
152 6         16 my @width_ratio = ();
153            
154 6         186 for my $col (map {$self->col($_)} (0..$self->cols-1)) {
  21         66  
155 21         138 push @min_col_widths, $col->get_min_width();
156 21         135 push @reg_col_widths, $col->get_reg_width();
157 21         105 push @width_ratio, ( $reg_col_widths[-1] / $min_col_widths[-1] );
158             }
159              
160 6         33 my ($min_width, $free_space, $ratios) = (0,0,0);
161 6         31 $min_width += $_ for @min_col_widths;
162 6         60 $free_space = $self->width - $min_width;
163 6         36 $ratios += $_ for @width_ratio;
164              
165 6 50       35 return if ($free_space == 0);
166 6 50       30 if ( $free_space ) {
167 6         171 for (0..$self->cols-1) {
168 21         111 $self->col($_)->width(($free_space/$ratios)*$width_ratio[$_] + $min_col_widths[$_]);
169             }
170             } else {
171 0         0 carp "Error: unable to resolve column widht, content requires more space than the table has.\n";
172             }
173             }
174              
175             sub is_last_in_row {
176 0     0 1 0 my ($self, $idx) = @_;
177 0         0 return ($idx == $self->cols-1); #index starts from 0
178             }
179              
180             sub is_last_in_col {
181 152     152 1 335 my ($self, $idx) = @_;
182 152         3734 return ($idx == $self->rows-1); #index starts from 0
183             }
184              
185             sub cycle_background_color {
186 2     2 1 12 my ($self, @colors) = @_;
187 2         7 my $length = (scalar @colors);
188 2         55 for (0..$self->rows-1) {
189 20         56 $self->[$_]->background_color( $colors[ $_ % $length ] );
190             }
191 2         25 return $self;
192             }
193              
194             1;
195              
196             =head1 NAME
197              
198             PDF::TableX - Moose driven table generation module that is uses famous PDF::API2
199              
200             =head1 VERSION
201              
202             Version 0.012
203              
204              
205             =head1 SYNOPSIS
206              
207             The module provides capabilities to create tabular structures in PDF files.
208             It is similar to PDF::Table module, however extends its functionality adding OO
209             interface and allowing placement of any element inside table cell such as image,
210             another pdf, or nested table.
211              
212             Sample usage:
213              
214             use PDF::API2;
215             use PDF::TableX;
216              
217             my $pdf = PDF::API2->new();
218             my $page = $pdf->page;
219             my $table = PDF::TableX->new(40,40); # create 40 x 40 table
220             $table
221             ->padding(3) # set padding for cells
222             ->border_width(2) # set border width
223             ->border_color('blue'); # set border color
224             $table->[0][0]->content("Sample text"); # place "Sample text" in cell 0,0 (first cell in first row)
225             $table->[0][1]->content("Some other text"); # place "Some other text" in cell 0,1
226             $table->draw($pdf, $page); # place table on the first page of pdf
227              
228             $pdf->saveas('some/file.pdf');
229              
230             =head1 ATTRIBUTES
231              
232             All attributes when set return $self allowing chaining of the calls.
233              
234             =head2 Style Definitions
235              
236             Following attributes take as argument either array reference with four values describing the style
237             in each cell side in followin order [TOP, RIGHT, BOTTOM, LEFT]. Alternatively a scalar value can be
238             provided in which case it is coerced to ARRAY REF
239              
240             =over 4
241              
242             =item * padding => [1,1,1,1]
243              
244             # set padding for all cells
245             $table->padding(2);
246             # the same as
247             $table->paddin([2,2,2,2]);
248             # set padding of the first row
249             $table->[0]->padding(4);
250             # set padding of the first column
251             $table->col(0)->padding(4);
252             # set padding of single cell
253             $table->[0][0]->padding(2);
254              
255             =item * border_width => [1,1,1,1]
256              
257             $table->border_width(2);
258             $table->border_width([2,3,4,5]);
259              
260             =item * border_color => ['black','black','black','black']
261              
262             $table->border_color('red');
263             $table->border_color(['#cccccc','white','green','blue']);
264              
265             =item * border_style => ['solid','solid','solid','solid']
266              
267             Currently the only supported style is 'solid'.
268              
269             =item * margin => [10/25.4*72,10/25.4*72,10/25.4*72,10/25.4*72]
270              
271             Margin is used currently to determine the space between top and bottom of the page.
272              
273             $table->margin(20);
274             $table->margin([20,10,10,2]);
275              
276             =back
277              
278             Following attributes require single value.
279              
280             =over 4
281              
282             =item * background_color => ''
283              
284             $table->background_color('blue');
285            
286             =item * text_align => 'left'
287              
288             Allowed values are: 'left', 'right', 'center', 'justify'
289              
290             # set text align in whole table
291             $table->text_align('left');
292             # set text align in single row
293             $table->[0]->text_align('left');
294             # set text align in single column
295             $table->col(0)->text_align('left');
296              
297             =item * font => 'Times'
298              
299             Allowed values are the names of PDF::API2 corefonts: Courier, Courier-Bold, Courier-BoldOblique,
300             Courier-Oblique, Helvetica, Helvetica-Bold, Helvetica-BoldOblique, Helvetica-Oblique, Symbol,
301             Times-Bold, Times-BoldItalic, Times-Italic, Times-Roman, ZapfDingbats
302              
303             $table->font('ZapfDingbats');
304              
305             =item * font_color => 'black'
306              
307             $table->font_color('green');
308              
309             =item * font_size => 12
310            
311             $table->font_size(10);
312            
313             =back
314              
315             =head2 Placing & Behaviour
316              
317             Following attributes control placing of the table and its behaviour
318              
319              
320             =over 4
321              
322             =item * width - width of the table
323              
324             =item * start_x - x position of the table
325              
326             =item * start_y - y position of the table
327              
328             =item * rows - number of table rows
329              
330             =item * cols - number of table columns
331              
332             =item * repeat_header - shall the header be repeated on every new page (default is 0, set 1 to repeat)
333              
334             =back
335              
336             =head1 METHODS
337              
338             =head2 cycle_background_color
339              
340             Set the background colors of rows. The method takes the list of colors and applies them to
341             subsequent rows. There is no limit to style e.g. only in odd/even fashio.
342              
343             # set odd and even background colors to black and white
344             $table->cycle_background_color('black','white');
345              
346             # set the background color of rows to cycle with three colors: black, white, red
347             $table->cycle_background_color('black','white','red');
348              
349             =head2 BUILD
350              
351             TODO
352              
353             =head2 add_row
354              
355             TODO
356              
357             =head2 col
358              
359             TODO
360              
361             =head2 draw
362              
363             TODO
364              
365             =head2 is_last_in_col
366              
367             TODO
368              
369             =head2 is_last_in_row
370              
371             TODO
372              
373             =head2 properties
374              
375             TODO
376              
377             =head1 EXTENDING THE MODULE
378              
379             PDF::TableX uses Moose::Role(s) to define the styles and placing of the table. They can be
380             relatively extended providing capabilites beyond those already available. Below code snipped
381             creates the role that uses elliptical background shape instead of rectangle.
382              
383             package EllipsedBackground;
384             use Moose::Role;
385              
386             sub draw_background {
387             my ($self, $x, $y, $gfx, $txt) = @_;
388             $gfx->linewidth(0);
389             $gfx->fillcolor('yellow');
390             $gfx->ellipse($x+$self->width/2, $y-$self->height/2, $self->width/2, $self->height/2);
391             $gfx->fill();
392             }
393              
394             use Moose::Util qw( apply_all_roles );
395             use PDF::TableX;
396             use PDF::API2;
397              
398             my $table = PDF::TableX->new(2,2);
399             my $pdf = PDF::API2->new();
400             $pdf->mediabox('a4');
401              
402             # set some styles
403             $table->padding(10)->border_width(1)->text_align('center');
404              
405             # apply moose roles to specific cells
406             apply_all_roles( $table->[0][0], 'ElipsedBackground' );
407             apply_all_roles( $table->[0][1], 'ElipsedBackground' );
408              
409             # set some content to those roles
410             $table->[0][0]->content("Some text");
411             $table->[0][1]->content("Some other text");
412              
413             # and finally draw it
414             $table->draw($pdf, 1);
415             # and save it
416             $pdf->saveas('some/output.pdf');
417              
418             =head1 AUTHOR
419              
420             Grzegorz Papkala, C<< <grzegorzpapkala at gmail.com> >>
421              
422             =head1 BUGS
423              
424             Please report any bugs or feature requests at: L<https://github.com/grzegorzpapkala/PDF-TableX/issues>
425              
426             =head1 SUPPORT
427              
428             PDF::TableX is hosted on GitHub L<https://github.com/grzegorzpapkala/PDF-TableX>
429              
430              
431             =head1 ACKNOWLEDGEMENTS
432              
433              
434             =head1 COPYRIGHT & LICENSE
435              
436             Copyright 2013 Grzegorz Papkala, all rights reserved.
437              
438             This program is free software; you can redistribute it and/or modify it
439             under the same terms as Perl itself.
440              
441             =cut