File Coverage

blib/lib/Data/Tabulate.pm
Criterion Covered Total %
statement 93 93 100.0
branch 28 28 100.0
condition 24 24 100.0
subroutine 16 16 100.0
pod 10 10 100.0
total 171 171 100.0


line stmt bran cond sub pod time code
1             package Data::Tabulate;
2              
3 9     9   67091 use warnings;
  9         7623  
  9         292  
4 9     9   51 use strict;
  9         15  
  9         165  
5 8     8   38 use Carp;
  8         13  
  8         2502  
6              
7             # ABSTRACT: Table generation!
8              
9             our $VERSION = 0.08;
10              
11              
12             sub new {
13 8     8 1 1228 my ($class) = @_;
14            
15 8         21 my $self = {};
16 8         25 bless $self,$class;
17            
18 8         41 $self->max_columns(100_000);
19 8         27 $self->min_columns(1);
20            
21 8         22 return $self;
22             }
23              
24              
25             sub render {
26 10     10 1 5424 my ($self,$module,$atts) = @_;
27            
28 10 100 100     90 if ( ! (defined $atts and ref($atts) eq 'HASH' and
      100        
      100        
29             exists $atts->{data} and ref($atts->{data}) eq 'ARRAY') ) {
30 4         392 croak "no data given";
31             }
32              
33 6 100       18 if ( !$module ) {
34 1         70 croak "no renderer module given";
35             }
36              
37 5         40 my @data = @{$atts->{data}};
  5         30  
38 5         10 my $tmp = $module;
39 5         38 $module = 'Data::Tabulate::Plugin::'.$module;
40            
41 5         23 $self->_load_module($module);
42            
43 4         17 my @table = $self->tabulate(@data);
44 4         18 my $plugin_obj = $module->new();
45            
46 4         18 for my $method(@{$self->{method_calls}->{$tmp}}){
  4         21  
47 2 100       19 if(!$plugin_obj->can($method->[0])){
48 1         73 croak 'renderer does not know ' . $method->[0];
49             }
50             else {
51 8     8   59 no strict 'refs';
  8         24  
  8         7150  
52 1         2 my $method_name = $method->[0];
53 1         2 my @params = @{$method->[1]};
  1         3  
54 1         5 $plugin_obj->$method_name(@params);
55             }
56            
57             }
58              
59 3 100       32 if ( !$plugin_obj->can('output') ) {
60 1         91 croak "renderer $module does not have an output method";
61             }
62              
63 2         8 return $plugin_obj->output(@table);
64             }
65              
66              
67             sub tabulate {
68 11     11 1 52 my ($self,@data) = @_;
69            
70 11         25 my $nr = scalar @data;
71 11         39 my $cols = int sqrt $nr;
72            
73             # the calculated number of columns should not exceed the maximum
74             # number of columns that the user has specified
75 11 100       41 if($cols > $self->max_columns){
76 1         4 $cols = $self->max_columns;
77             }
78            
79             # the calculated number of columns should be greater the minimum
80             # number of columns that the user has specified
81 11 100       55 if($cols < $self->min_columns){
82 3         7 $cols = $self->min_columns;
83             }
84            
85 11         65 $self->{cols} = $cols;
86            
87 11         28 my $index = $cols - 1;
88            
89             # tabulate data
90 11         33 my @tmp_data;
91 11         52 while ( $index < $nr ) {
92 30         52 my $start = $index - $cols + 1;
93 30         71 push @tmp_data, [ @data[ $start .. $index ] ];
94 30         76 $index += $cols;
95             }
96            
97 11         27 my $fill_value = $self->{fill_value};
98              
99 11         31 my $rest = ($cols - ($nr % $cols)) % $cols;
100 11         21 $self->{rest} = $rest;
101 11 100       46 if($rest > 0){
102            
103 6         15 my $start = $nr - ($cols - $rest);
104 6         14 my $end = $nr - 1;
105            
106 6         34 push @tmp_data, [
107             @data[$start..$end],
108             ($fill_value) x $rest,
109             ];
110             }
111            
112 11         25 $self->{rows} = scalar @tmp_data;
113            
114 11         47 return @tmp_data;
115             }
116              
117              
118             sub fill_with {
119 1     1 1 5 my ($self,$value) = @_;
120            
121 1         3 $self->{fill_value} = $value;
122             }
123              
124              
125             sub cols{
126 6     6 1 5128 my ($self) = @_;
127 6         24 return $self->{cols};
128             }
129              
130              
131             sub rows{
132 6     6 1 1188 my ($self) = @_;
133 6         25 return $self->{rows};
134             }
135              
136              
137             sub max_columns{
138 59     59 1 118 my ($self,$value) = @_;
139            
140 59 100 100     252 $self->{max_cols} = $value if defined $value and $value =~ /^[1-9]\d*$/;
141            
142 59         231 my $caller = (caller(1))[3];
143 59 100 100     312 if ( !( ($caller and $caller =~ /min_columns/) or not defined $self->min_columns) ) {
      100        
144 20 100       47 $self->min_columns($self->{max_cols}) if $self->{max_cols} < $self->min_columns;
145             }
146            
147 59         175 return $self->{max_cols};
148             }
149              
150              
151             sub min_columns{
152 79     79 1 157 my ($self,$value) = @_;
153            
154 79 100 100     239 $self->{min_cols} = $value if defined $value and $value =~ /^[1-9]\d*$/;
155            
156 79         299 my $caller = (caller(1))[3];
157 79 100 100     345 if ( !( $caller and $caller =~ /max_columns/) ){
158 30 100       88 $self->max_columns($self->{min_cols}) if $self->{min_cols} > $self->max_columns;
159             }
160            
161 79         270 return $self->{min_cols};
162             }
163              
164              
165             sub do_func{
166 2     2 1 705 my ($self,$module,$method,@params) = @_;
167            
168 2         4 push @{$self->{method_calls}->{$module}},[$method,[@params]];
  2         16  
169             }
170              
171              
172             sub reset_func{
173 1     1 1 732 my ($self,$module) = @_;
174 1         4 delete $self->{method_calls}->{$module};
175             }
176              
177              
178             #------------------------------------------------------------------------------#
179             # "private" methods #
180             #------------------------------------------------------------------------------#
181              
182             sub _load_module {
183 5     5   12 my ($self,$module) = @_;
184 5     3   335 eval "use $module";
  3         894  
  2         15135  
  2         51  
185 5 100       118 croak "could not load $module" if $@;
186             }
187              
188             1; # End of Data::Tabulate
189              
190             __END__