File Coverage

lib/PDF/Boxer/SpecParser.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package PDF::Boxer::SpecParser;
2             {
3             $PDF::Boxer::SpecParser::VERSION = '0.001'; # TRIAL
4             }
5 3     3   5815 use Moose;
  3         7  
  3         25  
6             # ABSTRACT: Convert markup to Perl data
7              
8 3     3   18748 use namespace::autoclean;
  3         7  
  3         27  
9              
10 3     3   698 use XML::Parser;
  0            
  0            
11              
12             has 'clean_whitespace' => ( isa => 'Bool', is => 'ro', default => 1 );
13              
14             has 'xml_parser' => ( isa => 'XML::Parser', is => 'ro', lazy_build => 1 );
15              
16             sub _build_xml_parser{
17             XML::Parser->new(Style => 'Tree');
18             }
19              
20             sub parse{
21             my ($self, $xml) = @_;
22             my $data = $self->xml_parser->parse($xml);
23              
24             my $spec = {};
25             $self->mangle_spec($spec, $data);
26             $spec = $spec->{children}[0];
27              
28             return $spec;
29             }
30              
31             sub mangle_spec{
32             my ($self, $spec, $data) = @_;
33             while(@$data){
34             my $tag = shift @$data;
35             my $element = shift @$data;
36             if ($tag eq '0'){
37             # !!??
38             # push(@{$spec->{value}}, $element);
39             } elsif ($tag eq 'text'){
40             $element->[0]{type} = 'Text';
41             my $kid = shift @$element;
42             $kid->{value} = [$self->clean_text($element->[1])];
43             push(@{$spec->{children}}, $kid);
44             } elsif ($tag eq 'textblock'){
45             $element->[0]{type} = 'TextBlock';
46             my $kid = shift @$element;
47             $kid->{value} = [$self->clean_text($element->[1])];
48             push(@{$spec->{children}}, $kid);
49             } elsif (lc($tag) eq 'image'){
50             $element->[0]{type} = 'Image';
51             push(@{$spec->{children}}, shift @$element);
52             } elsif (lc($tag) eq 'row'){
53             $element->[0]{type} = 'Row';
54             push(@{$spec->{children}}, shift @$element);
55             $self->mangle_spec($spec->{children}->[-1], $element);
56             } elsif (lc($tag) eq 'column'){
57             $element->[0]{type} = 'Column';
58             push(@{$spec->{children}}, shift @$element);
59             $self->mangle_spec($spec->{children}->[-1], $element);
60             } elsif (lc($tag) eq 'grid'){
61             $element->[0]{type} = 'Grid';
62             push(@{$spec->{children}}, shift @$element);
63             $self->mangle_spec($spec->{children}->[-1], $element);
64             } else {
65             $element->[0]{type} = 'Box';
66             push(@{$spec->{children}}, shift @$element);
67             $self->mangle_spec($spec->{children}->[-1], $element);
68             }
69             }
70             }
71              
72             sub clean_text{
73             my ($self, $element) = @_;
74             return if $element =~ /^[\s\n\r]*$/;
75             if ($self->clean_whitespace){
76             $element =~ s/^[\s\n\r]+//;
77             $element =~ s/[\s\n\r]+$//;
78             }
79             my @el = split(/\n/,$element);
80             if ($self->clean_whitespace){
81             foreach(@el){
82             s/^\s+//;
83             s/\s+$//;
84             }
85             }
86             return @el;
87             }
88              
89             __PACKAGE__->meta->make_immutable;
90              
91             1;
92              
93              
94             __END__
95             =pod
96              
97             =head1 NAME
98              
99             PDF::Boxer::SpecParser - Convert markup to Perl data
100              
101             =head1 VERSION
102              
103             version 0.001
104              
105             =head1 AUTHOR
106              
107             Jason Galea <lecstor@cpan.org>
108              
109             =head1 COPYRIGHT AND LICENSE
110              
111             This software is copyright (c) 2011 by Jason Galea.
112              
113             This is free software; you can redistribute it and/or modify it under
114             the same terms as the Perl 5 programming language system itself.
115              
116             =cut
117