File Coverage

lib/XML/SAX/SVGTransformer.pm
Criterion Covered Total %
statement 251 285 88.0
branch 86 126 68.2
condition 41 66 62.1
subroutine 27 29 93.1
pod 6 6 100.0
total 411 512 80.2


line stmt bran cond sub pod time code
1             package XML::SAX::SVGTransformer;
2              
3 4     4   361430 use strict;
  4         39  
  4         112  
4 4     4   24 use warnings;
  4         7  
  4         116  
5 4     4   26 use base 'XML::SAX::Base';
  4         7  
  4         1215  
6 4     4   20465 use Math::Matrix;
  4         94999  
  4         232  
7 4     4   2264 use Math::Trig qw/deg2rad/;
  4         46643  
  4         12326  
8              
9             our $VERSION = '0.05';
10             our $GroupId = 'SVGTransformer';
11              
12             my $IdMatrix = Math::Matrix->id(4);
13              
14             sub start_document {
15 7     7 1 129951 my $self = shift;
16 7         47 $self->SUPER::start_document(@_);
17 7         2971 $self->{_stack} = [];
18 7         27 $self->{_ops} = [];
19 7         18 $self->{_stash} = {};
20 7         21 $self->{_comment} = '';
21             }
22              
23             sub start_element {
24 33     33 1 35390 my $self = shift;
25 33         46 my $elem = $_[0];
26 33         77 my $name = lc $elem->{LocalName};
27 33 100 100     171 if ($name eq 'svg' && !$self->_seen($name) && !$self->_stash($name)) {
    100 66        
      66        
28 7         71 $self->_stash(svg => $elem);
29 7         17 $self->_stash(prefix => $elem->{Prefix});
30 7         18 return;
31             } elsif ($self->_stash('svg') && !$self->_stash('updated')) {
32 7         12 my @args;
33 7 100 100     39 if ($name eq 'g' && (_attr($elem, 'id') || '') eq $self->_group_id) {
      66        
34 2         5 push @args, $elem;
35             }
36 7         27 $self->_update_tags(@args);
37             }
38 26         80 $self->_push($name);
39 26         66 $self->SUPER::start_element(@_);
40             }
41              
42             sub comment {
43 7     7 1 2058 my ($self, $comment) = @_;
44 7 100       20 if ($self->_stash('svg')) {
45 3         8 my $data = $comment->{Data};
46 3   50     25 my @parts = split /(?:\s+|\s*,\s*)/, $data || '';
47 3 100 66     31 if (@parts == 4 && !grep !/^[-0-9.eE]+$/, @parts) {
48 2         6 $self->{_comment} = $data;
49 2         7 return;
50             }
51             }
52 5         26 $self->SUPER::comment($comment);
53             }
54              
55             sub end_element {
56 33     33 1 6942 my $self = shift;
57 33         47 my $elem = $_[0];
58 33         67 my $name = lc $elem->{LocalName};
59 33         75 my $popped = $self->_pop($name);
60 33         72 while (ref $popped) {
61 4         15 $self->_end_added_elements($popped);
62 4         384 $popped = $self->_pop($name);
63             }
64 33         97 $self->SUPER::end_element(@_);
65             }
66              
67             sub end_document {
68 7     7 1 1447 my $self = shift;
69 7         14 my @stacked = @{$self->{_stack}};
  7         19  
70 7 100       68 return unless @stacked;
71 1         4 while (my $popped = pop @stacked) {
72 1 50       3 die "Broken! got: $popped left:" . join(",", @stacked) unless ref $popped;
73 1         3 $self->_end_added_elements($popped);
74             }
75             }
76              
77             sub _end_added_elements {
78 5     5   11 my ($self, $tags) = @_;
79 5         12 for my $tag (reverse @$tags) {
80 6         66 my $prefix = $self->_stash('prefix');
81 6 50       44 $self->SUPER::end_element({
82             LocalName => $tag,
83             Name => $prefix ? "$prefix:$tag" : $tag,
84             Prefix => $prefix,
85             });
86             }
87             }
88              
89 0 0   0 1 0 sub info { shift->{_info} || {} }
90              
91             sub _update_tags {
92 7     7   16 my ($self, $group) = @_;
93              
94 7         17 my $svg = $self->_delete_stash('svg');
95              
96 7         18 my $svg_width = _attr($svg, 'width');
97 7         23 my $svg_height = _attr($svg, 'height');
98 7         16 my $svg_viewbox = _attr($svg, 'viewBox');
99 7         21 my $svg_version = _attr($svg, 'version');
100              
101 7 0 33     21 if (!$svg_viewbox && $svg_width && $svg_height) {
      33        
102 0         0 $svg_viewbox = "0 0 $svg_width $svg_height";
103             }
104              
105 7         9 my $view;
106 7         44 @$view{qw/min_x min_y max_x max_y tx ty w h/} = (0) x 8;
107              
108 7 100       22 $svg_viewbox = $self->{_comment} if $self->{_comment};
109              
110 7 50       21 if ($svg_viewbox) {
111 7         22 @$view{qw/min_x min_y w h/} = _split($svg_viewbox);
112 7         24 $view->{max_x} = $view->{min_x} + $view->{w};
113 7         13 $view->{max_y} = $view->{min_y} + $view->{h};
114             } else {
115 0         0 $view->{max_x} = $view->{w} = _numify($svg_width);
116 0         0 $view->{max_y} = $view->{h} = _numify($svg_height);
117             }
118              
119 7         11 my $new_group;
120 7 100       17 if (!$group) {
121 5 50       13 my $prefix = $svg->{Prefix} ? "$svg->{Prefix}:" : "";
122             $group = {
123             LocalName => 'g',
124             Name => $prefix . 'g',
125             Prefix => $svg->{Prefix},
126             NamespaceURI => $svg->{NamespaceURI},
127 5         23 Attributes => {
128             '{}id' => {
129             Name => 'id',
130             Value => $self->_group_id,
131             },
132             '{}transform' => {
133             Name => 'transform',
134             Value => '',
135             },
136             },
137             };
138 5         14 $new_group = 1;
139             }
140              
141 7         34 my $scale = $self->_scale($view, @$self{qw/Width Height/});
142 7         11 push @{$self->{_ops}}, ['scale', @$scale];
  7         20  
143              
144 7         14 my $transform = _attr($group, 'transform');
145              
146 7         24 $self->_parse_transform($transform);
147              
148 7         20 my $matrix = $self->_parse_transform($self->{Transform});
149              
150 7         21 $view = _to_hash($matrix * _to_matrix($view));
151 7         38 _translate($view);
152              
153 7         11 push @{$self->{_ops}}, ['translate', @$view{qw/tx ty/}];
  7         27  
154              
155 7         13 my $width = $view->{w};
156 7         11 my $height = $view->{h};
157              
158 7 100       17 if ($self->{KeepAspectRatio}) {
159 2         6 $width = $self->{Width};
160 2         4 $height = $self->{Height};
161 2         18 my @offset = (0, 0);
162 2 50       6 if ($width > $view->{w}) {
163 0         0 $offset[0] = ($width - $view->{w}) / 2;
164             }
165 2 100       7 if ($height > $view->{h}) {
166 1         12 $offset[1] = ($height - $view->{h}) / 2;
167             }
168              
169 2 100 66     11 if ($offset[0] or $offset[1]) {
170             my $wrapper = {
171             LocalName => $svg->{LocalName},
172             Name => $svg->{Name},
173             Prefix => $svg->{Prefix},
174             NamespaceURI => $svg->{NamespaceURI},
175 1         6 };
176             my $wrapper_group = {
177             LocalName => $group->{LocalName},
178             Name => $group->{Name},
179             Prefix => $group->{Prefix},
180             NamespaceURI => $group->{NamespaceURI},
181 1         4 };
182 1         5 _attr($wrapper, 'width', $width);
183 1         3 _attr($wrapper, 'height', $height);
184 1         5 _attr($wrapper, 'viewBox', "0 0 $width $height");
185              
186 1         16 _attr($wrapper_group, 'transform', "translate($offset[0] $offset[1])");
187              
188 1         3 _attr($group, 'id', undef);
189              
190 1         14 $self->_push(['svg', 'g']);
191 1         15 $self->SUPER::start_element($wrapper);
192 1         358 $self->SUPER::start_element($wrapper_group);
193             }
194             }
195              
196 7         117 _attr($svg, 'width', $view->{w});
197 7         19 _attr($svg, 'height', $view->{h});
198 7         65 _attr($svg, 'viewBox', "0 0 $view->{w} $view->{h}");
199              
200 7         26 $self->_push('svg');
201 7         39 $self->SUPER::start_element($svg);
202 7         1616 $self->SUPER::comment({Data => $svg_viewbox});
203              
204 7         670 $transform = $self->_ops_to_transform;
205 7         20 _attr($group, 'transform', $transform);
206 7 100 100     25 if ($new_group && $transform) {
207 4         15 $self->_push(['g']);
208 4         15 $self->SUPER::start_element($group);
209             }
210              
211 7         390 $self->_stash(updated => 1);
212              
213             $self->{_info} = {
214 7         57 width => $width,
215             height => $height,
216             version => $svg_version,
217             };
218             }
219              
220             sub _parse_transform {
221 14     14   33 my ($self, $transform) = @_;
222              
223 14 100       26 $transform = '' unless defined $transform;
224              
225 14         23 my @ops = @{$self->{_ops}};
  14         34  
226 14 100       28 if ($transform) {
227 6         39 my @parts = (lc $transform) =~ /(\w+(?:\([^)]*\))?)/g;
228 6         15 for my $op (reverse @parts) {
229 8         41 my ($name, $arg) = $op =~ /^(\w+)(?:\(([^)]*)\))?$/;
230 8         18 my @args = _split($arg);
231 8 100       49 if ($name eq 'rotate') {
    50          
    50          
    50          
232 6 100 66     45 if (@ops && $ops[-1][0] eq 'rotate') {
233 2         5 $ops[-1][1] += $args[0];
234 2         6 $ops[-1][1] %= 360;
235             } else {
236 4         17 push @ops, ['rotate', @args];
237             }
238             } elsif ($name eq 'flipx') {
239 0         0 my $m = Math::Matrix->diagonal(-1, 1, -1, 1);
240 0 0 0     0 if (@ops && $ops[-1][0] eq 'matrix') {
241 0         0 $ops[-1][1] *= $m;
242             } else {
243 0         0 push @ops, ['matrix', $m];
244             }
245             } elsif ($name eq 'flipy') {
246 0         0 my $m = Math::Matrix->diagonal(1, -1, 1, -1);
247 0 0 0     0 if (@ops && $ops[-1][0] eq 'matrix') {
248 0         0 $ops[-1][1] *= $m;
249             } else {
250 0         0 push @ops, ['matrix', $m];
251             }
252             } elsif ($name eq 'matrix') {
253 0         0 my $m = Math::Matrix->new([
254             [$args[0], $args[2], 0, 0],
255             [$args[1], $args[3], 0, 0],
256             [0, 0, $args[0], $args[2]],
257             [0, 0, $args[1], $args[3]],
258             ]);
259 0 0 0     0 if (@ops && $ops[-1] eq 'matrix') {
260 0         0 $ops[-1][1] *= $m;
261             } else {
262 0         0 push @ops, ['matrix', $m];
263             }
264             }
265             }
266 6         16 $self->{_ops} = \@ops;
267             }
268              
269 14         50 my $matrix = $IdMatrix->clone;
270 14         366 for my $op (@ops) {
271 20         2655 my ($name, @args) = @$op;
272 20 100       83 if ($name eq 'rotate') {
    50          
    50          
273 6   50     36 my $angle = deg2rad($args[0] || 0);
274 6         108 my $sin = sin $angle;
275 6         44 my $cos = cos $angle;
276 6         33 my $m = Math::Matrix->new([
277             [$cos, -$sin, 0, 0],
278             [$sin, $cos, 0, 0],
279             [0, 0, $cos, -$sin],
280             [0, 0, $sin, $cos],
281             ]);
282 6         235 $matrix *= $m;
283 6 50       2428 if ($matrix->equal($IdMatrix)) {
284 0         0 $matrix = $IdMatrix->clone;
285             }
286             } elsif ($name eq 'matrix') {
287 0         0 $matrix *= $args[0];
288             } elsif ($name eq 'scale') {
289 14         78 $matrix *= Math::Matrix->new(
290             [$args[0], 0, 0, 0],
291             [0, $args[1], 0, 0],
292             [0, 0, $args[0], 0],
293             [0, 0, 0, $args[1]],
294             );
295             }
296             }
297 14         3814 return $matrix;
298             }
299              
300             sub _ops_to_transform {
301 7     7   16 my $self = shift;
302 7         9 my @transform;
303 7         9 for my $op (@{$self->{_ops}}) {
  7         28  
304 18         43 my ($name, @args) = @$op;
305 18 100       97 if ($name eq 'rotate') {
    50          
    100          
    50          
306 4 50       17 next if !$args[0];
307 4         18 push @transform, "rotate($args[0])";
308             } elsif ($name eq 'matrix') {
309 0 0       0 next if $args[0]->equal($IdMatrix);
310 0         0 my $flatten = join ' ', _flatten($args[0]);
311 0         0 push @transform, "matrix($flatten)";
312             } elsif ($name eq 'scale') {
313 7 100 66     38 next if $args[0] == 1 && $args[1] == 1;
314 1         10 push @transform, "scale($args[0] $args[1])";
315             } elsif ($name eq 'translate') {
316 7 50 66     18 next if !$args[0] && !$args[1];
317 6   50     13 $args[0] ||= 0;
318 6   100     20 $args[1] ||= 0;
319 6         28 push @transform, "translate($args[0] $args[1])";
320             }
321             }
322 7         26 join ' ', reverse @transform;
323             }
324              
325             sub _numify {
326 38 100   38   77 my $number = shift or return 0;
327 30         51 $number =~ tr/0-9.eE\-//cd;
328 30         52 $number += 0;
329 30         55 $number =~ s/\.0+$//;
330 30 50       93 $number || 0;
331             }
332              
333             sub _split {
334 15     15   23 my $value = shift;
335 15 50       41 return unless defined $value;
336 15         90 map { _numify($_) } split /(?:\s+|\s*,\s*)/, $value;
  38         76  
337             }
338              
339             sub _flatten {
340 0     0   0 my $matrix = shift;
341 0         0 my $array = $matrix->as_array;
342 0         0 my @values = map { _numify($_) } (
  0         0  
343             $array->[0][0],
344             $array->[1][0],
345             $array->[0][1] - $array->[0][0],
346             $array->[1][1] - $array->[1][0],
347             $array->[0][2] + $array->[0][3],
348             $array->[1][2] + $array->[1][3],
349             );
350 0         0 @values;
351             }
352              
353             sub _translate {
354 7     7   10 my $set = shift;
355              
356 7 100       18 if ($set->{min_x}) {
357 6         27 $set->{max_x} -= $set->{min_x};
358 6         10 $set->{tx} -= $set->{min_x};
359 6         10 $set->{min_x} = 0;
360             }
361 7 100       28 if ($set->{min_y}) {
362 4         7 $set->{max_y} -= $set->{min_y};
363 4         6 $set->{ty} -= $set->{min_y};
364 4         21 $set->{min_y} = 0;
365             }
366             }
367              
368             sub _to_matrix {
369 7     7   11 my $set = shift;
370             Math::Matrix->new([
371             [@$set{qw/min_x max_x min_x max_x/}],
372             [@$set{qw/min_y min_y max_y max_y/}],
373             [@$set{qw/tx tx tx tx/}],
374 7         58 [@$set{qw/ty ty ty ty/}],
375             ]);
376             }
377              
378             sub _to_hash {
379 7     7   3026 my $matrix = shift;
380 7         13 my %hash;
381 7         28 @hash{qw/min_x min_y max_x max_y tx ty/} = (0, 0, 0, 0, 0, 0);
382 7         24 my $x = $matrix->getrow(0);
383 7         241 my $y = $matrix->getrow(1);
384 7         196 my $tx = $matrix->getrow(2);
385 7         184 my $ty = $matrix->getrow(3);
386 7         179 $hash{min_x} = $x->min->as_array->[0][0];
387 7         402 $hash{max_x} = $x->max->as_array->[0][0];
388 7         327 $hash{min_y} = $y->min->as_array->[0][0];
389 7         299 $hash{max_y} = $y->max->as_array->[0][0];
390 7         289 $hash{tx} = $tx->min->as_array->[0][0];
391 7         282 $hash{ty} = $ty->min->as_array->[0][0];
392 7         287 $hash{w} = $hash{max_x} - $hash{min_x};
393 7         26 $hash{h} = $hash{max_y} - $hash{min_y};
394 7         34 \%hash;
395             }
396              
397             sub _scale {
398 7     7   19 my ($self, $set, $x, $y) = @_;
399              
400 7         26 my ($scale_x, $scale_y) = (1, 1);
401 7 100 100     41 if ($x && $y) {
    100          
    50          
402 2 50       7 if ($set->{w}) {
403 2         8 $scale_x = $x / $set->{w};
404             }
405 2 50       9 if ($set->{h}) {
406 2         7 $scale_y = $y / $set->{h};
407             }
408 2 50       19 if ($self->{KeepAspectRatio}) {
409 2 50       9 if ($scale_x > $scale_y) {
410 0         0 $scale_x = $scale_y;
411             } else {
412 2         4 $scale_y = $scale_x;
413             }
414             }
415             } elsif ($x) {
416 1 50       4 if ($set->{w}) {
417 1         4 $scale_x = $x / $set->{w};
418             }
419 1         2 $scale_y = $scale_x;
420             } elsif ($y) {
421 0 0       0 if ($set->{h}) {
422 0         0 $scale_y = $y / $set->{h};
423             }
424 0         0 $scale_x = $scale_y;
425             }
426 7         19 return [$scale_x, $scale_y];
427             }
428              
429             sub _push {
430 38     38   70 my ($self, $name) = @_;
431 38         82 push @{$self->{_stack}}, $name;
  38         148  
432             }
433              
434             sub _pop {
435 37     37   69 my ($self, $name) = @_;
436 37         44 my $popped = pop @{$self->{_stack}};
  37         73  
437 37 50 66     149 if (!ref $popped && $name ne $popped) {
438 0         0 die "Broken! expected: $name got: $popped left:" . join(",", @{$self->{_stack}});
  0         0  
439             }
440 37         76 $popped;
441             }
442              
443             sub _seen {
444 8     8   38 my ($self, $name) = @_;
445 8         39 my $count = grep { $_ eq $name } @{$self->{_stack}};
  2         6  
  8         22  
446 8   100     68 return $count || 0;
447             }
448              
449             sub _group_id {
450 12     12   26 my $self = shift;
451 12 50       24 if ($self->{SessionId}) {
452 0         0 join '-', $GroupId, $self->{SessionId};
453             } else {
454 12         87 $GroupId;
455             }
456             }
457              
458             sub _stash {
459 74     74   103 my $self = shift;
460 74         111 my $key = shift;
461 74 100       132 if (@_) {
462 21         46 $self->{_stash}{$key} = shift;
463             }
464 74         231 $self->{_stash}{$key};
465             }
466              
467             sub _delete_stash {
468 7     7   15 my ($self, $key) = @_;
469 7         20 delete $self->{_stash}{$key};
470             }
471              
472             sub _attr {
473 75     75   95 my $elem = shift;
474 75         96 my $name = shift;
475 75 100       117 if (@_) {
476 33         53 my $value = shift;
477 33 100 100     129 if (defined $value && $value ne '') {
478 31 100       90 if (!exists $elem->{Attributes}{"{}$name"}{Name}) {
479 12         38 $elem->{Attributes}{"{}$name"}{Name} = $name;
480             }
481 31         73 return $elem->{Attributes}{"{}$name"}{Value} = $value;
482             } else {
483 2         8 delete $elem->{Attributes}{"{}$name"};
484 2         3 return;
485             }
486             } else {
487 42 50       79 return unless exists $elem->{Attributes};
488 42 100       123 return unless exists $elem->{Attributes}{"{}$name"};
489 22         67 return $elem->{Attributes}{"{}$name"}{Value};
490             }
491             }
492              
493             1;
494              
495             __END__