File Coverage

blib/lib/Data/Tabulate.pm
Criterion Covered Total %
statement 59 90 65.5
branch 16 28 57.1
condition 13 24 54.1
subroutine 11 16 68.7
pod 10 10 100.0
total 109 168 64.8


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