File Coverage

blib/lib/XML/Filter/TableWrapper.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	23	30	76.6
condition	1	2	50.0
subroutine	8	8	100.0
pod	4	5	80.0
total	93	102	91.1

line

stmt

bran

cond

sub

pod

time

code

package XML::Filter::TableWrapper;

$VERSION = 0.02;

=head1 NAME

XML::Filter::TableWrapper - Wrap a table's cells in to a certain number of rows

=head1 SYNOPSIS

use XML::Filter::TableWrapper;

use XML::SAX::Machines qw( Pipeline );

## Ouput a table with 5 rows, the last row having 3 cells:

Pipeline(

XML::Filter::TableWrapper->new(

Columns => 3, # The default is 5

\*STDOUT,

)->parse_string( "" . "... >>

" x 23 . "
21
22							=head1 DESCRIPTION
23
24							Takes a list of elements and inserts (by default) C<<
25							elements to make an table with a specified number of columns (5 by
26							default). By default, it assumes that the container element is named
27							"{}table" (the "{}" means it is not namespaced), but this can be changed:
28
29							XML::Filter::TableWrapper->new(
30							ListTags => "{$my_ns}rows",
31							Columns => 3,
32							);
33
34							for instance.
35
36							=head1 LIMITATIONS
37
38							These can be read as possible future features:
39
40							=over
41
42							=item *
43
44							Be able to translate the container tag to some other, for instance:
45
46							ListTags => {
47							"{}ul" => {
48							TableTag => "{}table",
49							RowTag => "{}tr",
50							CellTag => "{}td",
51							},
52							}
53
54							=item *
55
56							Autoadapt if the user specifies empty "{}" namespaces and the events
57							have no NamespaceURI defined, and vice versa.
58
59							=item *
60
61							Row filling instead of column filling.
62
63							=item *
64
65							Stripping of existing row tags, for "refilling" a table.
66
67							=item *
68
69							Callbacks to allow the various tags to be built, so they can have
70							attributes. This would be a decent way of allowing greybar, for
71							instance.
72
73							=back
74
75							=cut
76
77	1			1		105107	use XML::SAX::Base;
	1					2
	1					31
78
79							@ISA = qw( XML::SAX::Base );
80
81	1			1		4	use strict;
	1					1
	1					522
82
83							sub new {
84	1			1	0	781	my $self = shift->SUPER::new( @_ );
85
86	1	50				51	$self->{Columns} = 5 unless defined $self->{Columns};
87	1	50				6	$self->{ListTags} = "{}table"
88							unless $self->{ListTags};
89
90	1					4	$self->{ListTags} = {
91	1	50				8	map { ( $_ => undef ) } split /,\s*/, $self->{ListTags}
92							} unless ref $self->{ListTags};
93
94	1					3	return $self;
95							}
96
97							=item Columns
98
99							$h->Columns( 1024 );
100							my $columns = $h->Columns;
101
102							Set/get the number of columns to wrap to.
103
104							=cut
105
106							sub Columns {
107	1			1	1	434	my $self = shift;
108
109	1	50				6	$self->{Columns} = shift if @_;
110	1					3	return $self->{Columns};
111							}
112
113
114							sub start_document {
115	5			5	1	2198	my $self = shift;
116
117	5					12	$self->{Stack} = [];
118	5					19	$self->{Depth} = 0;
119	5					10	$self->{ColCount} = 0;
120
121	5					26	$self->SUPER::start_document( {} );
122							}
123
124
125							sub _elt {
126	9			9		14	my ( $elt, $name ) = ( shift, shift );
127
128							return {
129	9	50				47	NamespaceURI => $elt->{NamespaceURI},
130							Prefix => $elt->{Prefix},
131							LocalName => $name,
132							Name => $elt->{Prefix} ? "$elt->{Prefix}:$name" : $name,
133							};
134							}
135
136
137							sub start_element {
138	38			38	1	15629	my $self = shift;
139	38					48	my ( $elt ) = @_;
140
141	38	100				94	if ( $self->{Depth} == 1 ) {
142	33	100				71	if ( ! $self->{ColCount} ) {
143	9					21	my $row_elt = _elt $elt, "tr";
144	9					31	$self->SUPER::start_element( $row_elt );
145	9					921	$self->{EndRowElt} = { %$row_elt };
146							}
147
148	33					53	++$self->{ColCount};
149							}
150
151	38	100				85	++$self->{Depth} if $self->{Depth};
152
153	38					54	my $jc_name = $elt->{Name};
154	38		50			179	$jc_name = "{" . ( $elt->{NamespaceURI} \|\| "" ) . "}$jc_name";
155
156	38	100				105	if ( exists $self->{ListTags}->{$jc_name} ) {
157	5					8	push @{$self->{Stack}}, [ @{$self}{qw( Depth ColCount EndRowElt )} ];
	5					11
	5					15
158	5					9	$self->{Depth} = 1;
159	5					6	$self->{ColCount} = undef;
160	5					16	$self->{EndRowElt} = undef;
161							}
162
163	38					133	$self->SUPER::start_element( @_ );
164							}
165
166
167							sub end_element {
168	38			38	1	3603	my $self = shift;
169	38					49	my ( $elt ) = @_;
170
171	38					40	my $end_row_elt;
172
173	38	50				83	if ( $self->{Depth} ) {
174	38					42	--$self->{Depth};
175
176	38	100				93	if ( $self->{Depth} == 1 ) {
		50
177	33	100				81	if ( $self->{ColCount} >= $self->{Columns} ) {
178	5					8	$end_row_elt = delete $self->{EndRowElt};
179	5					9	$self->{ColCount} = 0;
180							}
181							}
182							elsif ( ! $self->{Depth} ) {
183	5	100				25	$self->SUPER::end_element( $self->{EndRowElt} )
184							if $self->{EndRowElt};
185	5					536	@{$self}{qw( Depth ColCount EndRowElt )} = @{pop @{$self->{Stack}}};
	5					16
	5					6
	5					13
186							}
187							}
188
189	38					135	$self->SUPER::end_element( @_ );
190
191	38	100				2379	$self->SUPER::end_element( $end_row_elt ) if $end_row_elt;
192							}
193
194
195							1;