File Coverage

blib/lib/LaTeX/TikZ/Functor.pm
Criterion Covered Total %
statement 67 72 93.0
branch 13 22 59.0
condition 4 9 44.4
subroutine 12 12 100.0
pod 2 3 66.6
total 98 118 83.0


line stmt bran cond sub pod time code
1             package LaTeX::TikZ::Functor;
2              
3 10     10   60 use strict;
  10         16  
  10         811  
4 10     10   57 use warnings;
  10         18  
  10         537  
5              
6             =head1 NAME
7              
8             LaTeX::TikZ::Functor - Build functor methods that recursively visit nodes of a LaTeX::TikZ::Set tree.
9              
10             =head1 VERSION
11              
12             Version 0.02
13              
14             =cut
15              
16             our $VERSION = '0.02';
17              
18             =head1 DESCRIPTION
19              
20             A functor takes a L<LaTeX::TikZ::Set> tree and clones it according to certain rules.
21              
22             Rules can apply not only to L<LaTeX::TikZ::Set> consumer objects, but also to the L<LaTeX::TikZ::Mod> consumer objects they contain.
23             The are stored as L<LaTeX::TikZ::Functor::Rule> objects.
24              
25             When the functor is called onto a set object, all its associated rules are tried successively, and the handler of the first matching rule is executed with :
26              
27             =over 4
28              
29             =item *
30              
31             the functor object as its first argument ;
32              
33             =item *
34              
35             the current set object as its second argument ;
36              
37             =item *
38              
39             the arguments passed to the functor itself starting at the third argument.
40              
41             =back
42              
43             The handler is expected to return the new set/mod that will in the resulting set tree.
44             If the new set is different from the original, then the functor is applied to all the mods of the set, and their cloned version are added to the new set.
45              
46             If no matching rule is found, the object is returned as-is.
47              
48             =cut
49              
50 10     10   59 use Carp ();
  10         16  
  10         169  
51              
52 10     10   51 use Sub::Name ();
  10         19  
  10         165  
53              
54 10     10   6237 use LaTeX::TikZ::Functor::Rule;
  10         29  
  10         304  
55              
56 10     10   337 use LaTeX::TikZ::Interface;
  10         26  
  10         207  
57              
58 10     10   54 use LaTeX::TikZ::Tools;
  10         19  
  10         2070  
59              
60             my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
61              
62             my $validate_spec;
63             BEGIN {
64             $validate_spec = Sub::Name::subname('validate_spec' => sub {
65 100         179 my ($spec) = @_;
66              
67 100         137 my ($replace, $target);
68 100 50 33     1294 if (defined $spec and ref $spec eq ''
      33        
69             and $spec =~ /^(\+?)([A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z][A-Za-z0-9_]*)*)$/) {
70 100   66     568 $replace = defined($1) && $1 eq '+';
71 100         312 $target = $2;
72             } else {
73 0         0 Carp::confess("Invalid rule spec $spec");
74             }
75              
76 100         366 return $target, $replace;
77 10     10   6288 });
78             }
79              
80             =head1 METHODS
81              
82             =head2 C<< new rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ] >>
83              
84             Creates a new functor object that will use both the default and these user-specified rules.
85             The functor is also a code reference that expects to be called against L<LaTeX::TikZ::Set> objects.
86              
87             The default set and mod rules clone their relevant objects, so you get a clone functor (for the default set types) if you don't specify any user rule.
88              
89             # The default is a clone method
90             my $clone = Tikz->functor;
91             my $dup = $set->$clone;
92              
93             If there is already a default rule for one of the C<$spec>s, it is replaced by the new one ; otherwise, the user rule is appended to the list of default rules.
94              
95             # A translator
96             my $translate = Tikz->functor(
97             # Only replace the way point sets are cloned
98             'LaTeX::TikZ::Set::Point' => sub {
99             my ($functor, $set, $x, $y) = @_;
100              
101             $set->new(
102             point => [
103             $set->x + $x,
104             $set->y + $y,
105             ],
106             label => $set->label,
107             pos => $set->pos,
108             );
109             },
110             );
111             my $shifted = $set->$translate(1, 1);
112              
113             But if one of the C<$spec>s begins with C<'+'>, the rule will replace I<all> default rules that apply to subclasses or subroles of C<$spec> (including C<$spec> itself).
114              
115             # A mod stripper
116             my $strip = Tikz->functor(
117             # Replace all existent mod rules by this simple one
118             '+LaTeX::TikZ::Mod' => sub { return },
119             );
120             my $naked = $set->$strip;
121              
122             The functor will map unhandled sets and mods to themselves without cloning them, since it has no way to know how to do it.
123             Thus, if you define your own L<LaTeX::TikZ::Set> or L<LaTeX::TikZ::Mod> object, be sure to register a default rule for it with the L</default_rule> method.
124              
125             =cut
126              
127             my @default_set_rules;
128             my @default_mod_rules;
129              
130             sub new {
131 10     10 1 45 my ($class, %args) = @_;
132              
133 10         53 my @set_rules = @default_set_rules;
134 10         35 my @mod_rules = @default_mod_rules;
135              
136 10 50       28 my @user_rules = @{$args{rules} || []};
  10         73  
137 10         50 while (@user_rules) {
138 10         56 my ($spec, $handler) = splice @user_rules, 0, 2;
139              
140 10         48 my ($target, $replace) = $validate_spec->($spec);
141              
142 10         146 my $rule = LaTeX::TikZ::Functor::Rule->new(
143             target => $target,
144             handler => $handler,
145             );
146              
147 10 100       123 $rule->insert(
148             into => $rule->is_set ? \@set_rules : \@mod_rules,
149             overwrite => 1,
150             replace => $replace,
151             );
152             }
153              
154 10         30 my %dispatch = map { $_->target => $_ } @set_rules, @mod_rules;
  90         372  
155              
156 10         34 my $self;
157              
158             $self = bless sub {
159 31     31   52 my $set = shift;
160              
161 31         96 $lts_tc->assert_valid($set);
162              
163 31         2037 my $rule = $dispatch{ref($set)};
164 31 50       85 unless ($rule) {
165 0         0 for (@set_rules) {
166 0 0       0 if ($_->handles($set)) {
167 0         0 $rule = $_;
168 0         0 last;
169             }
170             }
171             }
172 31 50       67 return $set unless $rule;
173              
174 31         154 my $new_set = $rule->handler->($self, $set, @_);
175 31 50       374 return $set if $new_set == $set;
176              
177 31         39 my @new_mods;
178             MOD:
179 31         100 for my $mod ($set->mods) {
180 10         25 my $rule = $dispatch{ref($mod)};
181 10 100       26 unless ($rule) {
182 6         13 for (@mod_rules) {
183 6 50       22 if ($_->handles($mod)) {
184 6         282 $rule = $_;
185 6         14 last;
186             }
187             }
188             }
189 10 50       59 push @new_mods, $rule ? $rule->handler->($self, $mod, @_)
190             : $mod;
191             }
192 31         357 $new_set->mod(@new_mods);
193              
194 31         208 return $new_set;
195 10         133 }, $class;
196             }
197              
198             LaTeX::TikZ::Interface->register(
199             functor => sub {
200 2     2 0 1729 shift;
201              
202 2         19 __PACKAGE__->new(rules => \@_);
203             },
204             );
205              
206             =head2 C<< default_rule $spec => $handler >>
207              
208             Adds to all subsequently created functors a default rule for the class or role C<$spec>.
209              
210             An exception is thrown if there is already a default rule for C<$spec> ; otherwise, the new rule is appended to the current list of rules.
211             But if C<$spec> begins with C<'+'>, the rule will replace I<all> default rules that apply to subclasses or subroles of C<$spec> (including C<$spec> itself).
212              
213             Returns true if and only if an existent rule was replaced.
214              
215             =cut
216              
217             sub default_rule {
218 90     90 1 152 shift;
219 90         175 my ($spec, $handler) = @_;
220              
221 90         263 my ($target, $replace) = $validate_spec->($spec);
222              
223 90         974 my $rule = LaTeX::TikZ::Functor::Rule->new(
224             target => $target,
225             handler => $handler,
226             );
227              
228 90 100       749 $rule->insert(
229             into => $rule->is_set ? \@default_set_rules : \@default_mod_rules,
230             overwrite => 0,
231             replace => $replace,
232             );
233             }
234              
235             =head1 SEE ALSO
236              
237             L<LaTeX::TikZ>, L<LaTeX::TikZ::Functor::Rule>.
238              
239             =head1 AUTHOR
240              
241             Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
242              
243             You can contact me by mail or on C<irc.perl.org> (vincent).
244              
245             =head1 BUGS
246              
247             Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
248             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
249              
250             =head1 SUPPORT
251              
252             You can find documentation for this module with the perldoc command.
253              
254             perldoc LaTeX::TikZ
255              
256             =head1 COPYRIGHT & LICENSE
257              
258             Copyright 2010 Vincent Pit, all rights reserved.
259              
260             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
261              
262             =cut
263              
264             1; # End of LaTeX::TikZ::Functor