=head1 VERSION
-Version 0.02
+Version 0.03
=cut
-our $VERSION = '0.02';
+our $VERSION = '0.03';
=head1 DESCRIPTION
use Carp ();
-use Any::Moose;
-use Any::Moose 'Util' => [ qw[find_meta does_role] ];
-use Any::Moose 'Util::TypeConstraints';
+use Mouse;
+use Mouse::Util qw<find_meta does_role>;
+use Mouse::Util::TypeConstraints;
=head1 ATTRIBUTES
=head1 METHODS
-=head2 C<< new target => $target, handler => $handler >>
+=head2 C<new>
+
+ my $rule = LaTeX::TikZ::Functor::Rule->new(
+ target => $target,
+ handler => $handler,
+ );
Constructs a new rule object with target C<$target> and handler C<$handler>.
my $meta = find_meta($target);
Carp::confess("No meta object associated with target $target")
unless defined $meta;
- $args{is_role} = $meta->isa(any_moose('Meta::Role'));
+ $args{is_role} = $meta->isa('Mouse::Meta::Role');
my $is_set;
if (does_role($target, 'LaTeX::TikZ::Set')) {
$class->$orig(%args);
};
-=head2 C<< insert into => \@list, overwrite => $overwrite, replace => $replace >>
+=head2 C<insert>
+
+ my $has_replaced = $rule->insert(
+ into => \@list,
+ overwrite => $overwrite,
+ replace => $replace,
+ );
Inserts the current rule into the list of rules C<@list>.
+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.
-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.
+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.
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.
All the subsequent rules in the list that inherit or consume the target will be removed.
+Returns true if and only if an existent rule was replaced.
+
=cut
sub insert {
my $overwrite = $args{overwrite};
my $replace = $args{replace};
- my $target = $rule->target;
- my $is_role = $rule->is_role;
-
if ($replace) {
- my @remove;
+ my (@remove, $replaced);
for my $i (0 .. $#$list) {
my $old_target = $list->[$i]->target;
if ($rule->handles($old_target)) {
- if (defined $rule) {
- splice @$list, $i, 1, $rule;
- $rule = undef;
- } else {
+ if ($replaced) {
push @remove, $i;
+ } else {
+ splice @$list, $i, 1, $rule;
+ $replaced = 1;
}
}
}
splice @$list, $_ - $shift, 1;
++$shift;
}
- return 1 unless defined $rule;
+ return 1 if $replaced;
} else { # Replace only an existent rule
+ my $target = $rule->target;
+
+ my $last_descendant = undef;
+ my $first_ancestor = undef;
for my $i (0 .. $#$list) {
- my $old_target = $list->[$i]->target;
+ my $old_rule = $list->[$i];
+ my $old_target = $old_rule->target;
if ($old_target eq $target) {
Carp::confess("Default rule already defined for target $target")
unless $overwrite;
splice @$list, $i, 1, $rule;
return 1;
+ } elsif ($rule->handles($old_target)) {
+ $last_descendant = $i;
+ } elsif ($old_rule->handles($target)) {
+ $first_ancestor = $i;
}
}
+
+ my $pos;
+ if (defined $first_ancestor) {
+ Carp::confess("Unsorted rule list")
+ if defined $last_descendant and $first_ancestor <= $last_descendant;
+ $pos = $first_ancestor;
+ } elsif (defined $last_descendant) {
+ $pos = $last_descendant + 1;
+ }
+
+ if (defined $pos) {
+ splice @$list, $pos, 0, $rule;
+ return 0;
+ }
}
push @$list, $rule;
return 0;
}
-=head2 C<handles $obj>
+=head2 C<handles>
+
+ $rule->handles($obj);
Returns true if and only if the current rule can handle the object or class/role name C<$obj>.
=head1 COPYRIGHT & LICENSE
-Copyright 2010 Vincent Pit, all rights reserved.
+Copyright 2010,2011,2012,2013,2014,2015 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.