From: Vincent Pit Date: Sun, 1 Aug 2010 20:31:11 +0000 (+0200) Subject: Move most of the functor logic into a new LT::Functor::Role class X-Git-Tag: v0.02~13 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=a44105abc490869376ff448faa654f429324abe2;p=perl%2Fmodules%2FLaTeX-TikZ.git Move most of the functor logic into a new LT::Functor::Role class --- diff --git a/MANIFEST b/MANIFEST index 744b0e5..ba92b57 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6,6 +6,7 @@ README lib/LaTeX/TikZ.pm lib/LaTeX/TikZ/Formatter.pm lib/LaTeX/TikZ/Functor.pm +lib/LaTeX/TikZ/Functor/Rule.pm lib/LaTeX/TikZ/Interface.pm lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm lib/LaTeX/TikZ/Mod.pm diff --git a/lib/LaTeX/TikZ/Functor.pm b/lib/LaTeX/TikZ/Functor.pm index eaf13ca..efa66a0 100644 --- a/lib/LaTeX/TikZ/Functor.pm +++ b/lib/LaTeX/TikZ/Functor.pm @@ -26,21 +26,18 @@ use Carp (); use Sub::Name (); +use LaTeX::TikZ::Functor::Rule; + use LaTeX::TikZ::Interface; use LaTeX::TikZ::Tools; -use Any::Moose 'Util' => [ qw[find_meta does_role] ]; - my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set'); -my @default_set_rules; -my @default_mod_rules; - -my ($validate_rule, $insert_rule); +my $validate_spec; BEGIN { - $validate_rule = Sub::Name::subname('validate_rule' => sub { - my ($spec, $handler) = @_; + $validate_spec = Sub::Name::subname('validate_spec' => sub { + my ($spec) = @_; my ($replace, $target); if (defined $spec and ref $spec eq '' @@ -51,73 +48,7 @@ BEGIN { Carp::confess("Invalid rule spec $spec"); } - (my $pm = $target) =~ s{::}{/}g; - $pm .= '.pm'; - require $pm; - - my $meta = find_meta($target); - Carp::confess("No meta object associated with target $target") - unless defined $meta; - my $is_role = $meta->isa(any_moose('Meta::Role')); - - my $is_set; - if (does_role($target, 'LaTeX::TikZ::Set')) { - $is_set = 1; - } elsif (does_role($target, 'LaTeX::TikZ::Mod')) { - $is_set = 0; - } else { - Carp::confess("Target $target is neither a set nor a mod"); - } - - Carp::confess("Invalid handler for rule spec $spec") - unless defined $handler and ref $handler eq 'CODE'; - - return [ $target, $handler, $replace, $is_role, $is_set ]; - }); - - $insert_rule = Sub::Name::subname('insert_rule' => sub { - my ($rule, $list, $overwrite) = @_; - - my ($target, $replace, $is_role) = @{$rule}[0, 2, 3]; - - if ($replace) { - my @remove; - - for my $i (0 .. $#$list) { - my $old_target = $list->[$i]->[0]; - if ($is_role ? does_role($old_target, $target) - : $old_target->isa($target)) { - if (defined $rule) { - splice @$list, $i, 1, $rule; - $rule = undef; - } else { - push @remove, $i; - } - } - } - - my $shift; - for (@remove) { - splice @$list, $_ - $shift, 1; - ++$shift; - } - return 1 unless defined $rule; - - } else { # Replace only an existent rule - - for my $i (0 .. $#$list) { - my $old_target = $list->[$i]->[0]; - if ($old_target eq $target) { - Carp::confess("Default rule already defined for target $target") - unless $overwrite; - splice @$list, $i, 1, $rule; - return 1; - } - } - } - - push @$list, $rule; - return 0; + return $target, $replace; }); } @@ -168,6 +99,9 @@ Thus, if you define your own L or L object, =cut +my @default_set_rules; +my @default_mod_rules; + sub new { my ($class, %args) = @_; @@ -178,12 +112,21 @@ sub new { while (@user_rules) { my ($spec, $handler) = splice @user_rules, 0, 2; - my $rule = $validate_rule->($spec, $handler); + my ($target, $replace) = $validate_spec->($spec); - $insert_rule->($rule, $rule->[4] ? \@set_rules : \@mod_rules, 1); + my $rule = LaTeX::TikZ::Functor::Rule->new( + target => $target, + handler => $handler, + ); + + $rule->insert( + into => $rule->is_set ? \@set_rules : \@mod_rules, + overwrite => 1, + replace => $replace, + ); } - my %dispatch = map { $_->[0] => $_ } @set_rules, @mod_rules; + my %dispatch = map { $_->target => $_ } @set_rules, @mod_rules; my $self; @@ -195,14 +138,14 @@ sub new { my $rule = $dispatch{ref($set)}; unless ($rule) { for (@set_rules) { - if ($_->[2] ? $set->does($_->[0]) : $set->isa($_->[0])) { + if ($_->handles($set)) { $rule = $_; last; } } - $rule = [ undef, sub { $_[1] } ] unless $rule; } - my $new_set = $rule->[1]->($self, $set, @_); + my $new_set = $rule ? $rule->handler->($self, $set, @_) + : $set; my $is_new = $new_set ne $set; my @new_mods; @@ -211,17 +154,14 @@ MOD: my $rule = $dispatch{ref($mod)}; unless ($rule) { for (@mod_rules) { - if ($_->[2] ? $mod->does($_->[0]) : $mod->isa($_->[0])) { + if ($_->handles($mod)) { $rule = $_; last; } } - unless ($rule) { - push @new_mods, $mod; - next MOD; - } } - push @new_mods, $rule->[1]->($self, $mod, @_); + push @new_mods, $rule ? $rule->handler->($self, $mod, @_) + : $mod; } $new_set->mod(@new_mods) if $is_new; @@ -251,13 +191,19 @@ Returns true if and only if an existent rule was replaced. sub default_rule { shift; + my ($spec, $handler) = @_; - my $rule = $validate_rule->(@_); + my ($target, $replace) = $validate_spec->($spec); + + my $rule = LaTeX::TikZ::Functor::Rule->new( + target => $target, + handler => $handler, + ); - $insert_rule->( - $rule, - $rule->[4] ? \@default_set_rules : \@default_mod_rules, - 0, + $rule->insert( + into => $rule->is_set ? \@default_set_rules : \@default_mod_rules, + overwrite => 0, + replace => $replace, ); } diff --git a/lib/LaTeX/TikZ/Functor/Rule.pm b/lib/LaTeX/TikZ/Functor/Rule.pm new file mode 100644 index 0000000..efaff7b --- /dev/null +++ b/lib/LaTeX/TikZ/Functor/Rule.pm @@ -0,0 +1,216 @@ +package LaTeX::TikZ::Functor::Rule; + +use strict; +use warnings; + +=head1 NAME + +LaTeX::TikZ::Functor::Rule - An object that specifies how functors should handle a certain kind of set or mod. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 DESCRIPTION + +A rule specifies how functors should handle a certain kind of set or mod. +A functor is basically an ordered collection of rules. + +=cut + +use Carp (); + +use Any::Moose; +use Any::Moose 'Util' => [ qw[find_meta does_role] ]; +use Any::Moose 'Util::TypeConstraints'; + +=head1 ATTRIBUTES + +=head2 C + +=cut + +has 'target' => ( + is => 'ro', + isa => 'ClassName|RoleName', + required => 1, +); + +=head2 C + +=cut + +has 'handler' => ( + is => 'ro', + isa => 'CodeRef', + required => 1, +); + +=head2 C + +=cut + +has 'is_role' => ( + is => 'ro', + isa => 'Bool', + required => 1, +); + +=head2 C + +=cut + +has 'is_set' => ( + is => 'ro', + isa => 'Bool', + required => 1, +); + +my $ltfrl_tc = subtype 'LaTeX::TikZ::Functor::RuleList' + => as 'ArrayRef[LaTeX::TikZ::Functor::Rule]'; + +=head1 METHODS + +=head2 C<< new target => $target, handler => $handler >> + +=cut + +around 'BUILDARGS' => sub { + my ($orig, $class, %args) = @_; + + my $target = $args{target}; + __PACKAGE__->meta->find_attribute_by_name('target') + ->type_constraint->assert_valid($target); + + (my $pm = $target) =~ s{::}{/}g; + $pm .= '.pm'; + require $pm; + + 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')); + + my $is_set; + if (does_role($target, 'LaTeX::TikZ::Set')) { + $is_set = 1; + } elsif (does_role($target, 'LaTeX::TikZ::Mod')) { + $is_set = 0; + } else { + Carp::confess("Target $target is neither a set nor a mod"); + } + $args{is_set} = $is_set; + + $class->$orig(%args); +}; + +=head2 C<< insert into => \@list, overwrite => $overwrite, replace => $replace >> + +Inserts the current rule into the list of rules C<@list>. + +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 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. + +=cut + +sub insert { + my ($rule, %args) = @_; + + my $list = $args{into}; + $ltfrl_tc->assert_valid($list); + + my $overwrite = $args{overwrite}; + my $replace = $args{replace}; + + my $target = $rule->target; + my $is_role = $rule->is_role; + + if ($replace) { + my @remove; + + 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 { + push @remove, $i; + } + } + } + + my $shift; + for (@remove) { + splice @$list, $_ - $shift, 1; + ++$shift; + } + return 1 unless defined $rule; + + } else { # Replace only an existent rule + + for my $i (0 .. $#$list) { + my $old_target = $list->[$i]->target; + if ($old_target eq $target) { + Carp::confess("Default rule already defined for target $target") + unless $overwrite; + splice @$list, $i, 1, $rule; + return 1; + } + } + } + + push @$list, $rule; + return 0; +} + +=head2 C + +Returns true if and only if the current rule can handle the object or class/role name C<$obj>. + +=cut + +sub handles { + my ($rule, $obj) = @_; + + $rule->is_role ? does_role($obj, $rule->target) : $obj->isa($rule->target); +} + +__PACKAGE__->meta->make_immutable; + +=head1 SEE ALSO + +L, L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc LaTeX::TikZ + +=head1 COPYRIGHT & LICENSE + +Copyright 2010 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. + +=cut + +1; # End of LaTeX::TikZ::Functor::Rule diff --git a/t/00-load.t b/t/00-load.t index cde10a2..a0af7c6 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -3,12 +3,13 @@ use strict; use warnings; -use Test::More tests => 33; +use Test::More tests => 34; BEGIN { use_ok( 'LaTeX::TikZ' ); use_ok( 'LaTeX::TikZ::Formatter' ); use_ok( 'LaTeX::TikZ::Functor' ); + use_ok( 'LaTeX::TikZ::Functor::Rule' ); use_ok( 'LaTeX::TikZ::Interface' ); use_ok( 'LaTeX::TikZ::Meta::TypeConstraint::Autocoerce' ); use_ok( 'LaTeX::TikZ::Mod' ); diff --git a/t/92-pod-coverage.t b/t/92-pod-coverage.t index 6d2e641..bf0ee70 100644 --- a/t/92-pod-coverage.t +++ b/t/92-pod-coverage.t @@ -15,7 +15,7 @@ my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; -plan tests => 33; +plan tests => 34; my $moose_private = { also_private => [ qr/^BUILD$/, qr/^DEMOLISH$/ ] }; @@ -25,6 +25,7 @@ pod_coverage_ok( 'LaTeX::TikZ::Interface' ); pod_coverage_ok( 'LaTeX::TikZ' ); pod_coverage_ok( 'LaTeX::TikZ::Formatter' ); pod_coverage_ok( 'LaTeX::TikZ::Functor' ); +pod_coverage_ok( 'LaTeX::TikZ::Functor::Rule' ); pod_coverage_ok( 'LaTeX::TikZ::Meta::TypeConstraint::Autocoerce' ); pod_coverage_ok( 'LaTeX::TikZ::Mod' ); pod_coverage_ok( 'LaTeX::TikZ::Mod::Clip' );