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.02';
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 Any::Moose 'Util' => [ qw[find_meta does_role] ];
29 use Any::Moose '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]';
88 =head2 C<< new target => $target, handler => $handler >>
90 Constructs a new rule object with target C<$target> and handler C<$handler>.
94 around 'BUILDARGS' => sub {
95 my ($orig, $class, %args) = @_;
97 my $target = $args{target};
98 __PACKAGE__->meta->find_attribute_by_name('target')
99 ->type_constraint->assert_valid($target);
101 (my $pm = $target) =~ s{::}{/}g;
105 my $meta = find_meta($target);
106 Carp::confess("No meta object associated with target $target")
107 unless defined $meta;
108 $args{is_role} = $meta->isa(any_moose('Meta::Role'));
111 if (does_role($target, 'LaTeX::TikZ::Set')) {
113 } elsif (does_role($target, 'LaTeX::TikZ::Mod')) {
116 Carp::confess("Target $target is neither a set nor a mod");
118 $args{is_set} = $is_set;
120 $class->$orig(%args);
123 =head2 C<< insert into => \@list, overwrite => $overwrite, replace => $replace >>
125 Inserts the current rule into the list of rules C<@list>.
127 If C<$replace> is false, then the rule will be appended to the C<@list> ; except if there already is 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.
129 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.
130 All the subsequent rules in the list that inherit or consume the target will be removed.
132 Returns true if and only if an existent rule was replaced.
137 my ($rule, %args) = @_;
139 my $list = $args{into};
140 $ltfrl_tc->assert_valid($list);
142 my $overwrite = $args{overwrite};
143 my $replace = $args{replace};
146 my (@remove, $replaced);
148 for my $i (0 .. $#$list) {
149 my $old_target = $list->[$i]->target;
150 if ($rule->handles($old_target)) {
154 splice @$list, $i, 1, $rule;
162 splice @$list, $_ - $shift, 1;
165 return 1 if $replaced;
167 } else { # Replace only an existent rule
168 my $target = $rule->target;
170 for my $i (0 .. $#$list) {
171 my $old_target = $list->[$i]->target;
172 if ($old_target eq $target) {
173 Carp::confess("Default rule already defined for target $target")
175 splice @$list, $i, 1, $rule;
185 =head2 C<handles $obj>
187 Returns true if and only if the current rule can handle the object or class/role name C<$obj>.
192 my ($rule, $obj) = @_;
194 $rule->is_role ? does_role($obj, $rule->target) : $obj->isa($rule->target);
197 __PACKAGE__->meta->make_immutable;
201 L<LaTeX::TikZ>, L<LaTeX::TikZ::Functor>.
205 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
207 You can contact me by mail or on C<irc.perl.org> (vincent).
211 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>.
212 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
216 You can find documentation for this module with the perldoc command.
220 =head1 COPYRIGHT & LICENSE
222 Copyright 2010 Vincent Pit, all rights reserved.
224 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
228 1; # End of LaTeX::TikZ::Functor::Rule