Changeset 2390 for lang/perl/Class-Hookable

Timestamp:

12/04/07 11:23:01 (13 months ago)

Author:

nyarla

Message:

lang/perl/Class-Hookable: I implemented registered_methods method and bug fix.

Location:

lang/perl/Class-Hookable/trunk

Files:

• lib/Class/Hookable.pm (modified) (4 diffs)
• t/03_utility/00_registered_hooks.t (modified) (1 diff)
• t/03_utility/02_registered_methods.t (added)

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

@@ -7 +7 @@
 use Scalar::Util();
 
-our $VERSION = '0.02';
+use vars qw( $VERSION );
+$VERSION = '0.03';
 
 sub new { bless {}, shift }
@@ -171 +172 @@
     }
 
+    @hooks = sort { $a cmp $b } @hooks;
     return @hooks;
 }
@@ -183 +185 @@
 
     return @{ $list };
+}
+
+sub registered_methods {
+    my $self    = shift;
+    my @methods = ();
+
+    if ( @_ > 0 ) {
+        my $object = shift;
+
+        if ( ref $object && ! Scalar::Util::blessed($object) ) {
+            Carp::croak "Argument is not blessed object or class name.";
+        }
+
+        my $is_class = ( ! ref $object ) ? 1 : 0 ;
+
+        for my $method ( keys %{ $self->hookable_all_methods } ) {
+            my $plugin  = $self->hookable_all_methods->{$method}->{'plugin'};
+            my $class   = ref $plugin || $plugin;
+            if ( $is_class ) {
+                push @methods, $method if ( $class eq $object );
+            }
+            else {
+                push @methods, $method if ( $plugin eq $object );
+            }
+        }
+    }
+    else {
+        @methods = keys %{ $self->hookable_all_methods };
+    }
+
+    @methods = sort { $a cmp $b } @methods;
+    return @methods;
 }
 
@@ -606 +640 @@
 Return value is a list of hash reference including plugin and callback.
 
+=head2 registered_methods
+
+  my @methods = $hook->registered_methods( $plugin );
+  my @methods = $hook->registered_methods( 'ClassName' );
+
+This method returns a registered method name.
+
+When calling without arguments, all registered method name is returned.
+and When specifying plugin object (or class name) as an arguments,
+the method name with which a plugin is registered is returned.
+
 =head2 delete_plugin
 

lang/perl/Class-Hookable/trunk/t/03_utility/00_registered_hooks.t

@@ -25 +25 @@
 is_deeply(
     [ $hook->registered_hooks ],
-    [ qw( foo.bar bar.baz baz.foo ) ],
+    [ qw( bar.baz baz.foo foo.bar ) ],
 );
 
 is_deeply(
     [ $hook->registered_hooks( $pluginA ) ],
-    [ qw( foo.bar bar.baz ) ],
+    [ qw( bar.baz foo.bar) ],
 );
 
 is_deeply(
     [ $hook->registered_hooks('PluginB') ],
-    [ qw(  foo.bar baz.foo ) ],
+    [ qw( baz.foo foo.bar ) ],
 );