line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- perl -*- |
2
|
|
|
|
|
|
|
# vim:ts=4:sw=4:aw:ai: |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# DBI::Format::SQLMinus - a package for displaying result tables |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Copyright (c) 2001, 2002 Thomas A. Lowery |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# The DBI::Shell::SQLMinus module is free software; you can redistribute |
9
|
|
|
|
|
|
|
# it and/or modify it under the same terms as Perl itself. |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# The "meat" of this format comes from interaction with the sqlminus |
14
|
|
|
|
|
|
|
# plugin module. |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
|
17
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
91
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
package DBI::Format::SQLMinus; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $VERSION = '11.96_03'; # TRIAL VERSION |
22
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
@DBI::Format::SQLMinus::ISA = qw(DBI::Format::Base); |
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
1
|
|
8
|
use Text::Abbrev; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
68
|
|
27
|
1
|
|
|
1
|
|
6
|
use Text::Reform qw(form break_with); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
9
|
|
28
|
|
|
|
|
|
|
|
29
|
1
|
|
|
1
|
|
868
|
use Data::Dumper; |
|
1
|
|
|
|
|
7565
|
|
|
1
|
|
|
|
|
487
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub header { |
32
|
20
|
|
|
20
|
0
|
62
|
my ($self, $sth, $fh, $sep) = @_; |
33
|
20
|
|
|
|
|
112
|
$self->SUPER::header($sth, $fh, $sep); |
34
|
20
|
|
|
|
|
49
|
$self->{'data'} = []; |
35
|
20
|
|
|
|
|
44
|
$self->{'formats'} = []; |
36
|
|
|
|
|
|
|
# |
37
|
|
|
|
|
|
|
# determine default behavior based either on the setting in |
38
|
|
|
|
|
|
|
# sqlminus, or pre-defined defaults. Without sqlminus loaded, |
39
|
|
|
|
|
|
|
# these defaults setting are static. Using the sqlminus "set" |
40
|
|
|
|
|
|
|
# command to change setting. |
41
|
|
|
|
|
|
|
# |
42
|
|
|
|
|
|
|
|
43
|
20
|
|
|
|
|
43
|
my ($breaks, $set, $column_format, $column_header_format, $sqlminus); |
44
|
|
|
|
|
|
|
|
45
|
20
|
50
|
|
|
|
70
|
if ( exists $self->{plugin}->{sqlminus} ) { |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# sqlminus plugin installed. |
48
|
20
|
|
|
|
|
50
|
$sqlminus = $self->{plugin}->{sqlminus}; |
49
|
|
|
|
|
|
|
|
50
|
20
|
|
|
|
|
47
|
$set = $sqlminus->{set_current}; |
51
|
20
|
|
|
|
|
48
|
$column_format = $sqlminus->{column_format}; |
52
|
|
|
|
|
|
|
$column_header_format = |
53
|
20
|
|
|
|
|
36
|
$sqlminus->{column_header_format}; |
54
|
20
|
|
|
|
|
42
|
$breaks = $sqlminus->{break_current}; |
55
|
|
|
|
|
|
|
} else { |
56
|
0
|
|
|
|
|
0
|
warn 'sqlminus plugin not installed\n'; |
57
|
0
|
|
|
|
|
0
|
$sqlminus = undef; |
58
|
0
|
|
|
|
|
0
|
$set = {}; |
59
|
0
|
|
|
|
|
0
|
$column_format = {}; |
60
|
0
|
|
|
|
|
0
|
$column_header_format = {}; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
20
|
|
|
|
|
40
|
$self->{feedback} = $set->{feedback}; |
64
|
20
|
|
|
|
|
35
|
$self->{limit} = $set->{limit}; |
65
|
20
|
|
|
|
|
45
|
$self->{pagesize} = $set->{pagesize}; |
66
|
20
|
|
|
|
|
44
|
$self->{recsepchar} = $set->{recsepchar}; |
67
|
20
|
|
|
|
|
56
|
$self->{recsep} = $set->{recsep}; |
68
|
|
|
|
|
|
|
|
69
|
20
|
|
|
|
|
33
|
$self->{pagefeed} = undef; |
70
|
20
|
|
|
|
|
46
|
$self->{pagelen} = 66; |
71
|
20
|
|
|
|
|
46
|
$self->{pagenum} = 0; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# $self->{breaks}; |
74
|
|
|
|
|
|
|
|
75
|
20
|
|
|
|
|
80
|
my $types = $sth->{'TYPE'}; |
76
|
20
|
|
|
|
|
281
|
my @right_justify; |
77
|
|
|
|
|
|
|
my @widths; |
78
|
20
|
|
|
|
|
0
|
my @heading; |
79
|
20
|
|
|
|
|
0
|
my @display; |
80
|
20
|
|
|
|
|
63
|
my $names = $sth->{'NAME'}; |
81
|
20
|
|
|
|
|
78
|
my $names_lc = $sth->{'NAME_lc'}; |
82
|
20
|
|
|
|
|
123
|
my $type; |
83
|
|
|
|
|
|
|
my $format_row; |
84
|
20
|
|
|
|
|
0
|
my @ul; |
85
|
20
|
|
|
|
|
0
|
my @fmtfunc; |
86
|
20
|
|
|
|
|
0
|
my @commify; |
87
|
|
|
|
|
|
|
|
88
|
20
|
|
|
|
|
181
|
my $attribs = { |
89
|
|
|
|
|
|
|
name => undef |
90
|
|
|
|
|
|
|
,name_lc => undef |
91
|
|
|
|
|
|
|
,precision => undef |
92
|
|
|
|
|
|
|
,scale => undef |
93
|
|
|
|
|
|
|
,len => undef |
94
|
|
|
|
|
|
|
,commify => undef |
95
|
|
|
|
|
|
|
,fmtfunc => undef |
96
|
|
|
|
|
|
|
,justify => undef |
97
|
|
|
|
|
|
|
,type => undef |
98
|
|
|
|
|
|
|
,format => undef |
99
|
|
|
|
|
|
|
,display => undef |
100
|
|
|
|
|
|
|
,heading => undef |
101
|
|
|
|
|
|
|
}; |
102
|
|
|
|
|
|
|
|
103
|
20
|
|
|
|
|
49
|
my @columns = (); |
104
|
|
|
|
|
|
|
|
105
|
20
|
|
|
|
|
136
|
for (my $i = 0; $i < $sth->{'NUM_OF_FIELDS'}; $i++) { |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
32
|
|
|
|
|
55
|
my $myattribs = (); |
109
|
32
|
|
|
|
|
429
|
$myattribs->{$_} = undef foreach ( sort keys %$attribs ); |
110
|
|
|
|
|
|
|
|
111
|
32
|
|
|
|
|
93
|
my ($format_names, $heading, $width, $type, $justify); |
112
|
|
|
|
|
|
|
# Default, left justify everything. |
113
|
32
|
|
|
|
|
53
|
$justify = '<'; |
114
|
32
|
|
|
|
|
58
|
$myattribs->{justify} = q{<}; |
115
|
|
|
|
|
|
|
|
116
|
32
|
|
|
|
|
49
|
push(@display, 1); |
117
|
|
|
|
|
|
|
|
118
|
32
|
|
|
|
|
58
|
$myattribs->{display}++; |
119
|
|
|
|
|
|
|
|
120
|
32
|
|
|
|
|
68
|
$myattribs->{name} = $names->[$i]; |
121
|
32
|
|
|
|
|
57
|
$myattribs->{name_lc} = $names_lc->[$i]; |
122
|
|
|
|
|
|
|
|
123
|
32
|
|
|
|
|
63
|
my $n_lc = $names_lc->[$i]; |
124
|
|
|
|
|
|
|
# Determine if a break point exists. |
125
|
32
|
50
|
|
|
|
78
|
if ( exists $breaks->{$n_lc} ) { |
126
|
0
|
|
|
|
|
0
|
print "Column " . $n_lc . " has a break point\n"; |
127
|
0
|
|
|
|
|
0
|
push @{$self->{breaks}->{order_of}}, $n_lc; |
|
0
|
|
|
|
|
0
|
|
128
|
0
|
|
|
|
|
0
|
for (keys %{$breaks->{$n_lc}}) { |
|
0
|
|
|
|
|
0
|
|
129
|
|
|
|
|
|
|
$self->{breaks}->{$n_lc}->{$_} = |
130
|
0
|
|
|
|
|
0
|
$breaks->{$n_lc}->{$_}; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
0
|
$self->{breaks}->{$n_lc}->{last_break_point} = undef; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
32
|
100
|
|
|
|
93
|
if ( exists $column_format->{$names_lc->[$i]} ) { |
137
|
28
|
|
|
|
|
62
|
my $cf = $column_format->{$names_lc->[$i]}; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# Determine if the column formating is on or off. |
140
|
28
|
100
|
66
|
|
|
141
|
if ( exists $cf->{on} and $cf->{on} ) { |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# Determine if this column is printed. |
143
|
|
|
|
|
|
|
# If this column is set to noprint, then skip. |
144
|
27
|
100
|
66
|
|
|
107
|
if (exists $cf->{noprint} and $cf->{noprint}) { |
145
|
2
|
|
|
|
|
5
|
$myattribs->{display} = 0; |
146
|
2
|
|
|
|
|
5
|
$display[$i] = 0; |
147
|
|
|
|
|
|
|
# Need to remember the attributes set for this column |
148
|
2
|
|
|
|
|
4
|
push(@columns, $myattribs); |
149
|
2
|
|
|
|
|
13
|
next; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
25
|
50
|
33
|
|
|
104
|
if ( exists $cf->{format} and defined $cf->{format} ) { |
153
|
25
|
|
|
|
|
46
|
$format_names = $cf->{format}; |
154
|
1
|
|
|
1
|
|
10
|
no warnings 'redundant'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
1567
|
|
155
|
25
|
|
|
|
|
81
|
$width = length sprintf( $format_names, " " ); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
25
|
100
|
66
|
|
|
108
|
if ( exists $cf->{justify} and defined $cf->{justify} ) { |
159
|
3
|
100
|
|
|
|
14
|
$justify = '^' if $cf->{justify} =~ m/^c/; |
160
|
3
|
100
|
|
|
|
12
|
$justify = '<' if $cf->{justify} =~ m/^l/; |
161
|
3
|
100
|
|
|
|
13
|
$justify = '>' if $cf->{justify} =~ m/^r/; |
162
|
|
|
|
|
|
|
|
163
|
3
|
|
|
|
|
5
|
$myattribs->{justify} = $justify; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
25
|
100
|
66
|
|
|
97
|
if (exists $cf->{heading} and defined $cf->{heading}) { |
167
|
9
|
|
|
|
|
16
|
$heading = $cf->{heading}; |
168
|
9
|
|
|
|
|
25
|
$myattribs->{heading} = $heading; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
26
|
|
|
|
|
52
|
push( @fmtfunc , $cf->{format_function} ); |
174
|
26
|
|
|
|
|
47
|
$myattribs->{fmtfunc} = $cf->{format_function}; |
175
|
26
|
|
50
|
|
|
90
|
push( @commify , $cf->{'commify'} || 0 ); |
176
|
26
|
|
|
|
|
45
|
$myattribs->{commify} = $cf->{commify}; |
177
|
|
|
|
|
|
|
|
178
|
26
|
|
|
|
|
49
|
$myattribs->{precision} = $cf->{precision}; |
179
|
26
|
|
|
|
|
40
|
$myattribs->{scale} = $cf->{scale}; |
180
|
26
|
|
|
|
|
44
|
$myattribs->{len} = $cf->{len}; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
|
184
|
30
|
100
|
|
|
|
68
|
$heading = $names->[$i] unless $heading; |
185
|
|
|
|
|
|
|
|
186
|
30
|
|
|
|
|
59
|
push(@heading, $heading); |
187
|
|
|
|
|
|
|
|
188
|
30
|
|
|
|
|
56
|
$type = $types->[$i]; |
189
|
30
|
|
|
|
|
51
|
$myattribs->{type} = $type; |
190
|
|
|
|
|
|
|
|
191
|
30
|
100
|
|
|
|
60
|
if ( $width ) { |
192
|
25
|
|
|
|
|
40
|
push( @widths, $width ); |
193
|
25
|
|
|
|
|
56
|
$myattribs->{width} = $width; |
194
|
|
|
|
|
|
|
} else { |
195
|
|
|
|
|
|
|
push(@widths, $self->_determine_width( |
196
|
5
|
|
|
|
|
28
|
$type, $sth->{PRECISION}->[$i] )); |
197
|
|
|
|
|
|
|
|
198
|
5
|
100
|
100
|
|
|
31
|
$widths[$i] = length $names->[$i] |
199
|
|
|
|
|
|
|
if (length $names->[$i] > ($widths[$i]||0)); |
200
|
5
|
|
|
|
|
11
|
$width = $widths[$i]; |
201
|
5
|
|
|
|
|
11
|
$myattribs->{width} = $width; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
|
205
|
30
|
50
|
|
|
|
69
|
if ( $justify ) { |
206
|
30
|
|
|
|
|
51
|
push( @right_justify, $justify ); |
207
|
30
|
|
|
|
|
55
|
$myattribs->{justify} = $justify; |
208
|
|
|
|
|
|
|
} else { |
209
|
0
|
|
0
|
|
|
0
|
push(@right_justify, |
210
|
|
|
|
|
|
|
($type == DBI::SQL_NUMERIC() || |
211
|
|
|
|
|
|
|
$type == DBI::SQL_DECIMAL() || |
212
|
|
|
|
|
|
|
$type == DBI::SQL_INTEGER() || |
213
|
|
|
|
|
|
|
$type == DBI::SQL_SMALLINT() || |
214
|
|
|
|
|
|
|
$type == DBI::SQL_FLOAT() || |
215
|
|
|
|
|
|
|
$type == DBI::SQL_REAL() || |
216
|
|
|
|
|
|
|
$type == DBI::SQL_BIGINT() || |
217
|
|
|
|
|
|
|
$type == DBI::SQL_TINYINT())); |
218
|
|
|
|
|
|
|
$myattribs->{justify} = |
219
|
0
|
|
0
|
|
|
0
|
($type == DBI::SQL_NUMERIC() || |
220
|
|
|
|
|
|
|
$type == DBI::SQL_DECIMAL() || |
221
|
|
|
|
|
|
|
$type == DBI::SQL_INTEGER() || |
222
|
|
|
|
|
|
|
$type == DBI::SQL_SMALLINT() || |
223
|
|
|
|
|
|
|
$type == DBI::SQL_FLOAT() || |
224
|
|
|
|
|
|
|
$type == DBI::SQL_REAL() || |
225
|
|
|
|
|
|
|
$type == DBI::SQL_BIGINT() || |
226
|
|
|
|
|
|
|
$type == DBI::SQL_TINYINT()); |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
30
|
100
|
|
|
|
65
|
$format_names = $justify x $width |
230
|
|
|
|
|
|
|
unless $format_names; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
push( @ul, defined $set->{underline} |
233
|
30
|
100
|
|
|
|
129
|
? "$set->{underline}" x $width |
234
|
|
|
|
|
|
|
: '-' x $width |
235
|
|
|
|
|
|
|
); |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
$set->{linesize} += $widths[$i] |
239
|
30
|
50
|
|
|
|
72
|
unless $set->{linesize}; |
240
|
|
|
|
|
|
|
|
241
|
30
|
|
|
|
|
62
|
$format_row .= $format_names; |
242
|
30
|
|
|
|
|
61
|
$format_row .= $set->{headsep}; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
|
245
|
30
|
|
|
|
|
213
|
push(@columns, $myattribs); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
20
|
|
|
|
|
57
|
$self->{'formats'} = \$format_row; |
249
|
20
|
|
|
|
|
102
|
$self->{'columns'} = \@columns; |
250
|
20
|
|
|
|
|
47
|
$self->{'headings'} = \@heading; |
251
|
20
|
|
|
|
|
39
|
$self->{'ul'} = \@ul; |
252
|
|
|
|
|
|
|
|
253
|
20
|
|
|
|
|
43
|
$column_header_format = $format_row; |
254
|
|
|
|
|
|
|
# print $fh form $header_form, (sprintf($format_row, @heading)), "\n" if $set->{heading}; |
255
|
|
|
|
|
|
|
print $fh form $column_header_format, @heading |
256
|
20
|
50
|
|
|
|
114
|
if $set->{heading}; |
257
|
|
|
|
|
|
|
print $fh form $column_header_format, @ul |
258
|
20
|
100
|
|
|
|
9526
|
if $set->{underline}; |
259
|
|
|
|
|
|
|
print $fh "\n" |
260
|
20
|
100
|
66
|
|
|
7341
|
if $set->{heading} and ! $set->{underline}; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub re_headers { |
264
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
265
|
0
|
|
|
|
|
0
|
my $fh = $self->{'fh'}; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
0
|
|
|
|
|
0
|
my ($set, $column_format, $column_header_format, $sqlminus); |
269
|
|
|
|
|
|
|
|
270
|
0
|
0
|
|
|
|
0
|
if ( exists $self->{plugin}->{sqlminus} ) { |
271
|
|
|
|
|
|
|
# sqlminus plugin installed. |
272
|
0
|
|
|
|
|
0
|
$sqlminus = $self->{plugin}->{sqlminus}; |
273
|
0
|
|
|
|
|
0
|
$set = $sqlminus->{set_current}; |
274
|
|
|
|
|
|
|
} else { |
275
|
0
|
|
|
|
|
0
|
return warn 'sqlminus plugin not installed\n'; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
0
|
$column_header_format = ${$self->{'formats'}}; |
|
0
|
|
|
|
|
0
|
|
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
print $fh "\n" |
281
|
0
|
0
|
|
|
|
0
|
if defined $set->{heading}; |
282
|
0
|
|
|
|
|
0
|
print $fh form $column_header_format, @{$self->{headings}} |
283
|
0
|
0
|
|
|
|
0
|
if defined $set->{heading}; |
284
|
0
|
|
|
|
|
0
|
print $fh form $column_header_format, @{$self->{ul}} |
285
|
0
|
0
|
|
|
|
0
|
if defined $set->{underline}; |
286
|
|
|
|
|
|
|
print $fh "\n" |
287
|
0
|
0
|
0
|
|
|
0
|
if defined $set->{heading} and not defined $set->{underline}; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub row { |
293
|
200
|
|
|
200
|
0
|
400
|
my($self, $orig_row) = @_; |
294
|
200
|
|
|
|
|
299
|
my $i = 0; |
295
|
200
|
|
|
|
|
768
|
my @row = $self->SUPER::row([@$orig_row]); # don't alter original |
296
|
|
|
|
|
|
|
|
297
|
200
|
|
|
|
|
446
|
my $columns = $self->{'columns'}; |
298
|
|
|
|
|
|
|
|
299
|
200
|
|
|
|
|
323
|
my $breaks = $self->{'breaks'}; |
300
|
|
|
|
|
|
|
|
301
|
200
|
|
|
|
|
258
|
my $format_rows = ${$self->{'formats'}}; |
|
200
|
|
|
|
|
414
|
|
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# if (exists $self->{'formats'} and defined $self->{'formats'} ){ |
304
|
|
|
|
|
|
|
# #print "using existing format '$format_rows'\n"; |
305
|
|
|
|
|
|
|
# $format_rows = ${$self->{'formats'}}; |
306
|
|
|
|
|
|
|
# } else { |
307
|
|
|
|
|
|
|
# for (my $i = 0; $i < $sth->{'NUM_OF_FIELDS'}; $i++) { |
308
|
|
|
|
|
|
|
# $format_rows .= |
309
|
|
|
|
|
|
|
# ($right_justify->[$i] ? "<" : ">") |
310
|
|
|
|
|
|
|
# x $widths->[$i] |
311
|
|
|
|
|
|
|
# . ($self->{recsep}?$self->{recsepchar}:''); |
312
|
|
|
|
|
|
|
# } |
313
|
|
|
|
|
|
|
# } |
314
|
|
|
|
|
|
|
|
315
|
200
|
|
|
|
|
451
|
$format_rows .= "\n"; |
316
|
|
|
|
|
|
|
|
317
|
200
|
|
|
|
|
294
|
my $fh = $self->{'fh'}; |
318
|
200
|
|
|
|
|
277
|
my @data; my $skip_rows = 0; my $skip_page = undef; |
|
200
|
|
|
|
|
286
|
|
|
200
|
|
|
|
|
276
|
|
319
|
|
|
|
|
|
|
COLUMN: |
320
|
200
|
|
|
|
|
1332
|
for (my $i = 0; $i < $self->{'sth'}->{'NUM_OF_FIELDS'}; $i++) { |
321
|
|
|
|
|
|
|
|
322
|
320
|
|
|
|
|
564
|
my $attribs = $columns->[$i]; |
323
|
320
|
50
|
|
|
|
767
|
if ( exists $breaks->{$attribs->{name_lc}} ) { |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
|
|
0
|
my $brk = $breaks->{$attribs->{name_lc}}; |
326
|
|
|
|
|
|
|
|
327
|
0
|
0
|
0
|
|
|
0
|
if (defined $brk->{last_break_point} and |
328
|
|
|
|
|
|
|
$brk->{last_break_point} ne $row[$i]) { |
329
|
0
|
0
|
|
|
|
0
|
if (exists $brk->{skip}) { |
330
|
|
|
|
|
|
|
$skip_rows = $skip_rows >= $brk->{skip} ? $skip_rows : |
331
|
0
|
0
|
|
|
|
0
|
$brk->{skip}; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
0
|
0
|
|
|
|
0
|
if (exists $brk->{skip_page}) { |
335
|
0
|
|
|
|
|
0
|
$skip_page = 1; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
0
|
0
|
|
|
|
0
|
if (exists $brk->{nodup}) { |
340
|
0
|
0
|
0
|
|
|
0
|
if (defined $brk->{last_break_point} |
341
|
|
|
|
|
|
|
and $brk->{last_break_point} eq $row[$i]) { |
342
|
0
|
|
|
|
|
0
|
push (@data, q{}); # empty row (noduplicate display) |
343
|
0
|
|
|
|
|
0
|
$brk->{last_break_point} = $row[$i]; |
344
|
0
|
|
|
|
|
0
|
next COLUMN; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
0
|
|
|
|
|
0
|
$brk->{last_break_point} = $row[$i]; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
320
|
100
|
|
|
|
684
|
next unless ($attribs->{'display'}); |
352
|
|
|
|
|
|
|
|
353
|
300
|
50
|
|
|
|
596
|
if ((ref $attribs->{fmtfunc}) eq 'CODE') { |
354
|
|
|
|
|
|
|
# warn "fmtcall\n"; |
355
|
|
|
|
|
|
|
push( @data , |
356
|
|
|
|
|
|
|
$attribs->{fmtfunc}( |
357
|
|
|
|
|
|
|
$row[$i] |
358
|
|
|
|
|
|
|
,$attribs->{precision} || $attribs->{width} |
359
|
|
|
|
|
|
|
,$attribs->{scale} || 0 |
360
|
0
|
|
0
|
|
|
0
|
,$attribs->{'commify'}) ); |
|
|
|
0
|
|
|
|
|
361
|
|
|
|
|
|
|
} else { |
362
|
300
|
|
|
|
|
1607
|
push( @data , $row[$i] ); |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# Deal with the breaks. |
367
|
200
|
50
|
|
|
|
600
|
if ($skip_page) { |
|
|
50
|
|
|
|
|
|
368
|
0
|
|
|
|
|
0
|
print $fh q{}; |
369
|
|
|
|
|
|
|
} elsif ($skip_rows) { |
370
|
0
|
|
|
|
|
0
|
print $fh "\n" x $skip_rows; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
200
|
|
|
|
|
673
|
print $fh form ( |
374
|
|
|
|
|
|
|
{ 'break' => break_with('') } |
375
|
|
|
|
|
|
|
, $format_rows, @data |
376
|
|
|
|
|
|
|
); |
377
|
|
|
|
|
|
|
|
378
|
200
|
|
|
|
|
93200
|
++$self->{'rows'}; |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
# Send a undef back to caller, signal limit reached. |
381
|
200
|
50
|
33
|
|
|
612
|
if (defined $self->{limit} and $self->{rows} >= $self->{limit}) { |
382
|
0
|
|
|
|
|
0
|
return undef; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
# Determine if this number of rows displayed is modulo of pagesize |
385
|
200
|
50
|
33
|
|
|
549
|
if (defined $self->{pagesize} |
386
|
|
|
|
|
|
|
and ($self->{'rows'} % $self->{pagesize}) == 0 ) { |
387
|
0
|
|
|
|
|
0
|
$self->re_headers(); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
200
|
|
|
|
|
878
|
return $self->{rows}; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub trailer { |
395
|
20
|
|
|
20
|
0
|
38
|
my $self = shift; |
396
|
20
|
|
|
|
|
43
|
my $widths = delete $self->{'widths'}; |
397
|
20
|
|
|
|
|
40
|
my $right_justify = delete $self->{'right_justify'}; |
398
|
|
|
|
|
|
|
|
399
|
20
|
|
|
|
|
34
|
delete $self->{recsep}; |
400
|
20
|
|
|
|
|
48
|
delete $self->{recsepchar}; |
401
|
20
|
|
|
|
|
270
|
print "Page Number: ", $self->{pagenum}, "\n"; |
402
|
|
|
|
|
|
|
|
403
|
20
|
|
|
|
|
132
|
$self->SUPER::trailer(@_); |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
1; |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=head1 NAME |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
DBI::Format::SQLMinus - A package for displaying result tables |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=head1 SYNOPSIS |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=head1 DESCRIPTION |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
THIS PACKAGE IS STILL VERY EXPERIMENTAL. THINGS WILL CHANGE. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head1 AUTHOR AND COPYRIGHT |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Orignal Format module is Copyright (c) 1997, 1998 |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
Jochen Wiedmann |
423
|
|
|
|
|
|
|
Am Eisteich 9 |
424
|
|
|
|
|
|
|
72555 Metzingen |
425
|
|
|
|
|
|
|
Germany |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
Email: joe@ispsoft.de |
428
|
|
|
|
|
|
|
Phone: +49 7123 14887 |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
SQLMinus is Copyright (c) 2001, 2002 Thomas A. Lowery |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
The DBI::Format::SQLMinus module is free software; you can redistribute it and/or |
433
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=head1 SEE ALSO |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
L, L, L |