File Coverage

blib/lib/PDF/TableX.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 PDF::TableX;
2              
3 6     6   91369 use Moose;
  0            
  0            
4             use MooseX::Types;
5             use MooseX::Types::Moose qw/Int/;
6              
7             use Carp;
8             use PDF::API2;
9              
10             use PDF::TableX::Row;
11             use PDF::TableX::Column;
12             use PDF::TableX::Cell;
13              
14             with 'PDF::TableX::Stylable';
15              
16             our $VERSION = '0.014';
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             use overload '@{}' => sub { return $_[0]->{_children}; }, fallback => 1;
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             my ($self) = @_;
60             $self->_create_initial_struct;
61             };
62              
63             # private methods
64             sub _create_initial_struct {
65             my ($self) = @_;
66             if ( my $rows = $self->rows ) {
67             $self->{rows} = 0;
68             for (0..$rows-1) {
69             $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             my ($self, @attrs) = @_;
83             @attrs = scalar(@attrs) ? @attrs : $self->attributes;
84             return (map { $_ => $self->$_ } @attrs);
85             }
86              
87             sub add_row {
88             my ($self, $row) = @_;
89             $self->{rows}++;
90             push @{$self->{_children}}, $row;
91             }
92              
93             sub col {
94             my ($self, $i) = @_;
95             return $self->{_cols}->[$i] if (defined $self->{_cols}->[$i]);
96             my $col = PDF::TableX::Column->new();
97             for ( @{$self} ) {
98             $col->add_cell( $_->[$i] );
99             }
100             $self->{_cols}->[$i] = $col;
101             return $col;
102             }
103              
104             sub draw {
105             my ($self, $pdf, $page, $y, $col_widths) = @_;
106             my $spanned = 0;
107             $self->{start_y} = $y || $self->{start_y};
108             $self->_set_col_widths($col_widths);
109             # get gfx, txt page objects in proper order to prevent from background hiding the text
110             my @states = ($page->gfx, $page->text, $page->gfx, $page->text, $page->gfx, $page->text);
111             ROW:
112             for (@{$self->{_children}}) {
113             my ($row_height, $overflow) = $self->_draw_row( $_, @states );
114             if ( $overflow ) {
115             $spanned++;
116             $page = $pdf->page;
117             $self->{start_y} = [ $page->get_mediabox ]->[3] - $self->margin->[0];
118             @states = ($page->gfx, $page->text, $page->gfx, $page->text, $page->gfx, $page->text);
119             if ( $self->repeat_header ) {
120             my ($row_height, $overflow) = $self->_draw_row( $self->[0], @states );
121             $self->{start_y} -= $row_height;
122             }
123             redo ROW;
124             } else {
125             $self->{start_y} -= $row_height;
126             }
127             }
128             return ($page, $spanned, $self->{start_y});
129             }
130              
131             sub _draw_row {
132             my ($self, $row, @states) = @_;
133             my ($row_height, $overflow) = $row->draw_content($self->start_x, $self->start_y, $states[4], $states[5] );
134             $row->height( $row_height );
135             $row->draw_background($self->start_x, $self->start_y, $states[0], $states[1]);
136             $row->draw_borders($self->start_x, $self->start_y, $states[2], $states[3]);
137             return ($row_height, $overflow);
138             }
139              
140             sub _set_col_widths {
141             my ($self, $col_widths) = @_;
142            
143             if ( defined $col_widths && scalar(@{$col_widths}) ) {
144             for (0..$self->cols-1) {
145             $self->col($_)->width( $col_widths->[$_] );
146             }
147             return;
148             }
149            
150             my @min_col_widths = ();
151             my @reg_col_widths = ();
152             my @width_ratio = ();
153            
154             for my $col (map {$self->col($_)} (0..$self->cols-1)) {
155             push @min_col_widths, $col->get_min_width();
156             push @reg_col_widths, $col->get_reg_width();
157             push @width_ratio, ( $reg_col_widths[-1] / $min_col_widths[-1] );
158             }
159              
160             my ($min_width, $free_space, $ratios) = (0,0,0);
161             $min_width += $_ for @min_col_widths;
162             $free_space = $self->width - $min_width;
163             $ratios += $_ for @width_ratio;
164              
165             return if ($free_space == 0);
166             if ( $free_space ) {
167             for (0..$self->cols-1) {
168             $self->col($_)->width(($free_space/$ratios)*$width_ratio[$_] + $min_col_widths[$_]);
169             }
170             } else {
171             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             my ($self, $idx) = @_;
177             return ($idx == $self->cols-1); #index starts from 0
178             }
179              
180             sub is_last_in_col {
181             my ($self, $idx) = @_;
182             return ($idx == $self->rows-1); #index starts from 0
183             }
184              
185             sub cycle_background_color {
186             my ($self, @colors) = @_;
187             my $length = (scalar @colors);
188             for (0..$self->rows-1) {
189             $self->[$_]->background_color( $colors[ $_ % $length ] );
190             }
191             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