Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

part of the way to proxying overload

  • Loading branch information...
commit 4f81c84171e818d59f770f625ac55204b82dd5dd 1 parent bf15937
@rjbs authored
Showing with 48 additions and 20 deletions.
  1. +22 −0 lib/metamethod.pm
  2. +26 −20 t/overloads.t
View
22 lib/metamethod.pm
@@ -51,6 +51,28 @@ sub import {
*{"$caller\::$key"} = $to_install{ $key };
}
+ if ($arg->{overload}) {
+ my %copy = %{ $arg->{overload} };
+ for my $ol (keys %copy) {
+ next if $ol eq 'fallback';
+ next if ref $copy{ $ol };
+
+ my $name = $copy{ $ol };
+ $copy{ $ol } = sub {
+ $_[0]->$name(@_[ 1 .. $#_ ]);
+ };
+ }
+
+ # We need string eval to set the caller to a variable. -- rjbs, 2009-03-26
+ # We must do this before casting magic so that overload.pm can find the
+ # right entries in the stash to muck with. -- rjbs, 2009-03-26
+ die unless eval qq{
+ package $caller;
+ use overload %copy;
+ 1;
+ };
+ }
+
cast %{"::$caller\::"}, $wiz;
}
View
46 t/overloads.t
@@ -2,26 +2,32 @@ use strict;
use warnings;
use Test::More 'no_plan';
-use metamethod ();
+BEGIN {
+ package OLP; # overloads pass through
-TODO: {
- local $TODO = 'figure out how the crap overloading works';
+ use metamethod
+ passthru => [ 'ISA' ],
+ overload => {
+ '@{}' => 'foo',
+ fallback => 1,
+ },
+ metamethod => sub {
+ my ($self, $method, $args) = @_;
+ warn "called: " . join(q{, }, @_) . "\n";
+ return [ $method, $args ];
+ };
+}
- my @calls;
- {
- package OLP; # overloads pass through
- metamethod->import(
- metamethod => sub {
- my ($self, $method, $args) = @_;
- push @calls, $method;
- return $method;
- },
- overloads => 'metamethod',
- passthru => [ 'ISA' ],
- );
- }
+my $olp = bless {} => 'OLP';
- my $olp = bless {} => 'OLP';
- my $str = "$olp";
- is($str, '(""', "we stringified to the stringification method name");
-}
+my $control = $olp->new(1,2,3);
+is_deeply(
+ $control,
+ [ new => [ 1, 2, 3 ] ],
+ "our control call worked",
+);
+
+# my $str = "$olp";
+# is($str, '(""', "we stringified to the stringification method name");
+use Data::Dumper;
+warn Dumper([ @{ $olp } ]);
Please sign in to comment.
Something went wrong with that request. Please try again.