File Coverage

lib/XML/SAX/SVGTransformer.pm
Criterion Covered Total %
statement 249 283 87.9
branch 92 132 69.7
condition 40 68 58.8
subroutine 24 26 92.3
pod 5 5 100.0
total 410 514 79.7


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