1 package LaTeX::TikZ::Functor::Rule;
8 LaTeX::TikZ::Functor::Rule - An object that specifies how functors should handle a certain kind of set or mod.
16 our $VERSION = '0.03';
20 A rule specifies how functors (L<LaTeX::TikZ::Functor> objects) should handle a certain kind of set or mod.
21 A functor is basically an ordered collection of rules.
28 use Mouse::Util qw<find_meta does_role>;
29 use Mouse::Util::TypeConstraints;
35 A class or role name against which set or mod candidates will be matched.
36 It must consume either L<LaTeX::TikZ::Set> or L<LaTeX::TikZ::Mod>, directly or through inheritance.
42 isa => 'ClassName|RoleName',
48 The code reference executed when the rule handles a given set or mod object.
49 It is called with the L<LaTeX::TikZ::Functor> object as its first argument, the set/mod object as its second, and then the arguments passed to the functor itself.
61 True if and only if the target is a role.
73 True when the target does the L<LaTeX::TikZ::Set> role, and false when it does L<LaTeX::TikZ::Mod>.
83 my $ltfrl_tc = subtype 'LaTeX::TikZ::Functor::RuleList'
84 => as 'ArrayRef[LaTeX::TikZ::Functor::Rule]';
90 my $rule = LaTeX::TikZ::Functor::Rule->new(
95 Constructs a new rule object with target C<$target> and handler C<$handler>.
99 around 'BUILDARGS' => sub {
100 my ($orig, $class, %args) = @_;
102 my $target = $args{target};
103 __PACKAGE__->meta->find_attribute_by_name('target')
104 ->type_constraint->assert_valid($target);
106 (my $pm = $target) =~ s{::}{/}g;
110 my $meta = find_meta($target);
111 Carp::confess("No meta object associated with target $target")
112 unless defined $meta;
113 $args{is_role} = $meta->isa('Mouse::Meta::Role');
116 if (does_role($target, 'LaTeX::TikZ::Set')) {
118 } elsif (does_role($target, 'LaTeX::TikZ::Mod')) {
121 Carp::confess("Target $target is neither a set nor a mod");
123 $args{is_set} = $is_set;
125 $class->$orig(%args);
130 my $has_replaced = $rule->insert(
132 overwrite => $overwrite,
136 Inserts the current rule into the list of rules C<@list>.
137 The list is expected to be ordered, in that each rule must come after all the rules that have a target that inherits or consumes the original rule's own target.
139 If C<$replace> is false, then the rule will be inserted into C<@list> after all the rules applying to the target's subclasses/subroles and before all its superclasses/superroles ; except if there is already an existent entry for the same target, in which case it will be overwritten if C<$overwrite> is true, or an exception will be thrown if it is false.
141 If C<$replace> is true, then the rule will replace the first rule in the list that is a subclass or that consumes the role denoted by the target.
142 All the subsequent rules in the list that inherit or consume the target will be removed.
144 Returns true if and only if an existent rule was replaced.
149 my ($rule, %args) = @_;
151 my $list = $args{into};
152 $ltfrl_tc->assert_valid($list);
154 my $overwrite = $args{overwrite};
155 my $replace = $args{replace};
158 my (@remove, $replaced);
160 for my $i (0 .. $#$list) {
161 my $old_target = $list->[$i]->target;
162 if ($rule->handles($old_target)) {
166 splice @$list, $i, 1, $rule;
174 splice @$list, $_ - $shift, 1;
177 return 1 if $replaced;
179 } else { # Replace only an existent rule
180 my $target = $rule->target;
182 my $last_descendant = undef;
183 my $first_ancestor = undef;
185 for my $i (0 .. $#$list) {
186 my $old_rule = $list->[$i];
187 my $old_target = $old_rule->target;
188 if ($old_target eq $target) {
189 Carp::confess("Default rule already defined for target $target")
191 splice @$list, $i, 1, $rule;
193 } elsif ($rule->handles($old_target)) {
194 $last_descendant = $i;
195 } elsif ($old_rule->handles($target)) {
196 $first_ancestor = $i;
201 if (defined $first_ancestor) {
202 Carp::confess("Unsorted rule list")
203 if defined $last_descendant and $first_ancestor <= $last_descendant;
204 $pos = $first_ancestor;
205 } elsif (defined $last_descendant) {
206 $pos = $last_descendant + 1;
210 splice @$list, $pos, 0, $rule;
221 $rule->handles($obj);
223 Returns true if and only if the current rule can handle the object or class/role name C<$obj>.
228 my ($rule, $obj) = @_;
230 $rule->is_role ? does_role($obj, $rule->target) : $obj->isa($rule->target);
233 __PACKAGE__->meta->make_immutable;
237 L<LaTeX::TikZ>, L<LaTeX::TikZ::Functor>.
241 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
243 You can contact me by mail or on C<irc.perl.org> (vincent).
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.
252 You can find documentation for this module with the perldoc command.
256 =head1 COPYRIGHT & LICENSE
258 Copyright 2010,2011,2012,2013,2014,2015 Vincent Pit, all rights reserved.
260 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
264 1; # End of LaTeX::TikZ::Functor::Rule