]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/commitdiff
Move most of the autoload logic into Autocoerce->load
authorVincent Pit <vince@profvince.com>
Tue, 20 Jul 2010 20:00:20 +0000 (22:00 +0200)
committerVincent Pit <vince@profvince.com>
Tue, 20 Jul 2010 20:00:20 +0000 (22:00 +0200)
This saves space, simplify the coerce wrapper, and improve covering
granularity.

lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm

index 4706998ef34e0610da97cdbf8da8073b55584ff8..9cc2322913697542f680313b7c9bba6aeba995dc 100644 (file)
@@ -60,47 +60,51 @@ around 'new' => sub {
  $parent_name =~ s/::+/_/g;
 
  my $tc;
- $args{constraint} = Sub::Name::subname("${parent_name}_load" => sub {
-  my ($thing) = @_;
+ $args{constraint} = Sub::Name::subname('_load' => sub {
+  $tc->load(@_);
+ });
+
+ $tc = $class->$orig(%args);
+};
 
-  # First, try a possible user defined constraint
-  my $user = $tc->user_constraint;
-  if (defined $user) {
-   my $ok = $user->($thing);
-   return 1 if $ok;
-  }
+sub load {
+ my ($tc, $thing) = @_;
 
-  # When ->check is called inside coerce, a return value of 0 means that
-  # coercion should take place, while 1 signifies that the value is already
-  # OK.
+ # First, try a possible user defined constraint
+ my $user = $tc->user_constraint;
+ if (defined $user) {
+  my $ok = $user->($thing);
+  return 1 if $ok;
+ }
 
-  my $class = blessed($thing);
-  return 0 unless $class;
-  return 1 if     $class->isa($tc->parent_name);
+ # When ->check is called inside coerce, a return value of 0 means that
+ # coercion should take place, while 1 signifies that the value is already
+ # OK.
 
-  my $mapper = $tc->mapper;
-  my $pm = $class = $tc->$mapper($class);
+ my $class = blessed($thing);
+ return 0 unless $class;
+ return 1 if     $class->isa($tc->parent_name);
 
-  $pm =~ s{::}{/}g;
-  $pm .= '.pm';
-  return 0 if $INC{$pm}; # already loaded
+ my $mapper = $tc->mapper;
+ my $pm = $class = $tc->$mapper($class);
 
-  local $@;
-  eval { require $pm; 1 };
+ $pm =~ s{::}{/}g;
+ $pm .= '.pm';
+ return 0 if $INC{$pm}; # already loaded
 
 return 0;
});
local $@;
eval { require $pm; 1 };
 
$tc = $class->$orig(%args);
-};
return 0;
+}
 
 around 'coerce' => sub {
  my ($orig, $tc, $thing) = @_;
 
  # The original coerce gets an hold onto the type coercions *before* calling
  # the constraint. Thus, we have to force the loading before recalling into
- # $orig. This is achieved by calling ->check.
- return $thing if $tc->check($thing);
+ # $orig. This is achieved by calling ->load.
+ return $thing if $tc->load($thing);
 
  $tc->$orig($thing);
 };