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__ |