| 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__ |