Changeset 3345 for lang/perl/Class-Hookable

Timestamp:

12/20/07 14:12:50 (13 months ago)

Author:

nyarla

Message:

lang/perl/Class-Hookable: I changed the target the delete_plugin method deletes.

Location:

lang/perl/Class-Hookable/trunk

Files:

• lib/Class/Hookable.pm (modified) (6 diffs)
• t/03_utility/14_delete_plugin.t (modified) (1 diff)

lang/perl/Class-Hookable/trunk/lib/Class/Hookable.pm

@@ -202 +202 @@
         for my $method ( keys %{ $self->hookable_all_methods } ) {
             my $plugin  = $self->hookable_all_methods->{$method}->{'plugin'};
+            next if ( ! defined $plugin );
             my $class   = ref $plugin || $plugin;
             if ( $is_class ) {
@@ -240 +241 @@
     }
     else {
-        for my $plugin ( @plugins ) {
-            $self->delete_plugin( $plugin, $hook );
-        }
-    }
+        my @new;
+        for my $action ( $self->registered_callbacks( $hook ) ) {
+            my $plugin = $action->{'plugin'};
+            my $class  = ref $plugin || $plugin;
+            for my $object ( @plugins ) {
+                if ( ref $object && ! Scalar::Util::blessed($object) ) {
+                    Carp::croak "Argument is not blessed object or class name.";
+                }
+
+                my $is_class = ( ! ref $object ) ? 1 : 0 ;
+                if ( $is_class ) {
+                    push @new, $action if ( $class ne $object );
+                }
+                else {
+                    push @new, $action if ( $plugin ne $object );
+                }
+            }
+        }
+        $self->hookable_all_hooks->{$hook} = \@new;
+    } 
 }
 
@@ -267 +284 @@
 
 sub delete_method {
-    my ( $self, $method ) = @_;
+    my ( $self, $method, @plugins ) = @_;
 
     Carp::croak "Method name is not specified."
         if ( ! defined $method );
 
-    delete $self->hookable_all_methods->{$method};
+    return if ( ! defined $self->hookable_all_methods->{$method} );
+
+    my $plugin = $self->hookable_all_methods->{$method}->{'plugin'};
+    my $class  = ref $plugin || $plugin;
+
+    if ( @plugins == 0 ) {
+        delete $self->hookable_all_methods->{$method};
+    }
+    else {
+        for my $object ( @plugins ) {
+            my $is_class = ( ! ref $object ) ? 1 : 0 ;
+            if ( $is_class ) {
+                delete $self->hookable_all_methods->{$method}
+                    if ( $class eq $object );
+            }
+            else {
+                delete $self->hookable_all_methods->{$method}
+                    if ( $plugin eq $object );
+            }
+        }
+    }
 }
 
@@ -293 +330 @@
 
 sub delete_plugin {
-    my ( $self, $object, @hooks ) = @_;
+    my ( $self, $object, @points ) = @_;
 
     if ( ref $object && ! Scalar::Util::blessed($object) ) {
@@ -299 +336 @@
     }
 
-    my $is_class = ( ! ref $object ) ? 1  : 0 ;
-    @hooks = keys %{ $self->hookable_all_hooks } if ( @hooks == 0 );
-
-    for my $hook ( $self->registered_hooks( $object ) ) {
-        next if ( ! grep { $hook eq $_ } @hooks );
-
-        my @actions = ();
-        for my $action ( $self->registered_callbacks( $hook ) ) {
-            my $plugin  = $action->{'plugin'};
-            my $class   = ref $plugin || $plugin;
-            if ( $is_class ) {
-                push @actions, $action if ( $class ne $object );
-            }
-            else {
-                push @actions, $action if ( $plugin ne $object );
-            }
-        }
-
-        $self->hookable_all_hooks->{$hook} = \@actions;
-    }
-
+    if ( @points == 0 ) {
+        push @points, $self->registered_hooks( $object );
+        push @points, $self->registered_methods( $object );
+    }
+
+    for my $point ( @points ) {
+        $self->delete_hook( $point => $object );
+        $self->delete_method( $point => $object );
+    }
 }
 
@@ -787 +812 @@
 
   $hook->delete_plugin( $plugin );
-  $hook->delete_plugin( ClassName => qw( hook.A hook.B ) );
+  $hook->delete_plugin( ClassName => qw( hook.A method.A ) );
 
 This method deletes a registered plugin.
 
 A plugin object or class name is specified as the first argument,
-and some hook names is specified as an argument after that.
+and hook names or method names are specified as an argument after that.
 
 When specifying only a plugin object (or class name) as an argument,
-a plugin is deleted from all hooks.
-
-And when specifying a plugin object (or class name) and hooks as arguments,
-a plugin is deleted from specified hooks.
+a plugin is deleted from all hooks and all methods.
+
+And when specifying a plugin object (or class name) and hook names or method names as arguments,
+a plugin is deleted from specified hooks and specified methods.
 
 =head1 ACCESSOR METOHDS

lang/perl/Class-Hookable/trunk/t/03_utility/14_delete_plugin.t

@@ -4 +4 @@
 use warnings;
 
-use Test::More tests => 2;
+use Test::More tests => 4;
 use Class::Hookable;
 
 my $hook = Class::Hookable->new;
-my $pluginA = PluginA->new;
-my $pluginB = PluginB->new;
+my $plugin = Plugin->new;
 
 $hook->register_hook(
-    $pluginA,
-    'hook.A' => $pluginA->can('foo'),
-    'hook.B' => $pluginA->can('bar'),
+    $plugin,
+    'hook.A' => $plugin->can('foo'),
+    'hook.B' => $plugin->can('foo'),
 );
 
-$hook->register_hook(
-    $pluginB,
-    'hook.A' => $pluginB->can('foo'),
-    'hook.B' => $pluginB->can('bar'),
+$hook->register_method(
+    $plugin,
+    'method.A' => $plugin->can('bar'),
+    'method.B' => $plugin->can('bar'),
 );
 
-$hook->delete_plugin( $pluginA, 'hook.B' );
+$hook->delete_plugin( $plugin => qw( hook.A method.B ) );
 
 is_deeply(
-    [ $hook->registered_hooks( $pluginA ) ],
-    [qw( hook.A )],
+    [ $hook->registered_hooks( $plugin ) ],
+    [qw( hook.B )],
 );
 
-$hook->delete_plugin( $pluginB );
+is_deeply(
+    [ $hook->registered_methods( $plugin ) ],
+    [qw( method.A )],
+);
+
+$hook->delete_plugin( $plugin );
 
 is_deeply(
-    [ $hook->registered_hooks( 'PluginB' ) ],
+    [ $hook->registered_hooks( $plugin ) ],
     [],
 );
 
-package PluginA;
+is_deeply(
+    [ $hook->registered_methods( $plugin ) ],
+    [],
+);
+
+package Plugin;
 
 sub new { bless {}, shift }
 sub foo {}
 sub bar {}
-
+sub baz {}
 1;
-
-package PluginB;
-
-sub new { bless {}, shift }
-sub foo {}
-sub bar {}