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