Changeset 25141 for lang

Timestamp:

11/27/08 21:28:44 (4 years ago)

Author:

yappo

Message:

add before & after

Location:

lang/perl/Shika/trunk

Files:

• lib/Shika.pm (modified) (2 diffs)
• t/030_method-modifiers (added)
• t/030_method-modifiers/01_before_simple.t (added)
• t/030_method-modifiers/02_after_simple.t (added)

lang/perl/Shika/trunk/lib/Shika.pm

@@ -25 +25 @@
         has      => {},
         default  => {},
+        modifier => {},
     };
 
     no strict 'refs';
+    *{"$pkg\::before"}  = \&_before;
+    *{"$pkg\::after"}   = \&_after;
     *{"$pkg\::meta"}    = sub { $meta };
 }
@@ -240 +243 @@
 }
 
+sub _install_modifier {
+    my($pkg, $name) = @_;
+    my $modifier = _init_modifier($pkg, $name);
+    my $before = $modifier->{before};
+    my $after  = $modifier->{after};
+    my $around = $modifier->{around};
+
+    if (@$before && @$after) {
+        $modifier->{cache} = sub {
+            $_->(@_) for @{$before};
+            my @rval;
+            ((defined wantarray) ?
+                ((wantarray) ?
+                    (@rval = $modifier->{around_cache}->(@_))
+                    :  
+                    ($rval[0] = $modifier->{around_cache}->(@_)))
+                :  
+                $modifier->{around_cache}->(@_));
+            $_->(@_) for @{$after};
+            return unless defined wantarray;
+            return wantarray ? @rval : $rval[0];
+        }
+    } elsif (@$before && !@$after) {
+        $modifier->{cache} = sub {
+            $_->(@_) for @{$before};
+            return $modifier->{around_cache}->(@_);
+        }
+    } elsif (@$after && !@$before) {
+        $modifier->{cache} = sub {
+            my @rval;
+            ((defined wantarray) ?
+                ((wantarray) ?
+                    (@rval = $modifier->{around_cache}->(@_))
+                    :  
+                    ($rval[0] = $modifier->{around_cache}->(@_)))
+                :  
+                $modifier->{around_cache}->(@_));
+            $_->(@_) for @{$after};
+            return unless defined wantarray;
+            return wantarray ? @rval : $rval[0];
+        }
+    } else {
+        $modifier->{cache} = $modifier->{around_cache};
+    }
+
+    no strict 'refs';
+    no warnings 'redefine';
+    *{"$pkg\::$name"} = sub { goto $modifier->{cache} };
+}
+
+sub _init_modifier {
+    my($pkg, $name) = @_;
+    die "The method '$name' is not found in the inheritance hierarchy for class $pkg"
+        unless $pkg->can($name);
+    my $code = $pkg->can($name);
+    $pkg->meta->{modifier}->{$name} ||= +{
+        around_cache => $code,
+        cache        => $code,
+        orig         => $code,
+        around       => [],
+        before       => [],
+        after        => [],
+    };
+}
+
+sub _before {
+    my $pkg = caller(0);
+    my $name = shift;
+    my $modifier = _init_modifier($pkg, $name);
+    unshift @{ $modifier->{before} }, $_[0];
+    _install_modifier($pkg, $name);
+}
+
+sub _after {
+    my $pkg = caller(0);
+    my $name = shift;
+    my $modifier = _init_modifier($pkg, $name);
+    push @{ $modifier->{after} }, $_[0];
+    _install_modifier($pkg, $name);
+}
+
+# utils
+
 sub _load_class {
     my $role = shift;