allow array of hashes in event listeners

This works around a bug in the pure-Perl YAML.pm that does not allow '$' as the first character of a hash key inside of an array. See ingydotnet/yaml-pm#36 ingydotnet/yaml-pm#48 ingydotnet/yaml-pm#94 and ingydotnet/yaml-pm#146) Fixes #6
preaction · Mar 2, 2015 · ec07812 · ec07812
1 parent 488dc3f
commit ec07812
Show file tree

Hide file tree

Showing 2 changed files with 108 additions and 37 deletions.
diff --git a/lib/Beam/Wire.pm b/lib/Beam/Wire.pm
@@ -269,6 +269,22 @@ Attach event listeners using L<Beam::Emitter|Beam::Emitter>.
 Now, when the C<emitter> fires off its events, they are dispatched to the
 appropriate listeners.
 
+In order to work around a bug in YAML.pm, you can also specify event listeners
+as an array of hashes:
+
+    emitter:
+        class: My::Emitter
+        on:
+            - before_my_event:
+                $ref: listener
+                $method: on_before_my_event
+            - my_event:
+                $ref: listener
+                $method: on_my_event
+            - my_event:
+                $ref: other_listener
+                $method: on_my_event
+
 =head3 Config Services
 
 A config service allows you to read a config file and use it as a service, giving
@@ -746,21 +762,33 @@ sub create_service {
 
     if ( $service_info{on} ) {
         my %meta = $self->get_meta_names;
-        for my $event ( keys %{ $service_info{on} } ) {
-            my @listeners   = ref $service_info{on}{$event} eq 'ARRAY'
-                            ? @{ $service_info{on}{$event} }
-                            : $service_info{on}{$event}
-                            ;
-
-            for my $listener ( @listeners ) {
-                # XXX: Make $class and $extends work here
-                # XXX: Make $args prepend arguments to the listener
-                # XXX: Make $args also resolve refs
-                my $method = $listener->{ $meta{method} };
-                my $listen_svc = $self->get( $listener->{ $meta{ref} } );
-                $service->on( $event => sub { $listen_svc->$method( @_ ) } );
+        my @listeners;
+
+        if ( ref $service_info{on} eq 'ARRAY' ) {
+            @listeners = map { [ %$_ ] } @{ $service_info{on} };
+        }
+        elsif ( ref $service_info{on} eq 'HASH' ) {
+            for my $event ( keys %{ $service_info{on} } ) {
+                if ( ref $service_info{on}{$event} eq 'ARRAY' ) {
+                    push @listeners,
+                        map {; [ $event => $_ ] }
+                        @{ $service_info{on}{$event} };
+                }
+                else {
+                    push @listeners, [ $event => $service_info{on}{$event} ];
+                }
             }
         }
+
+        for my $listener ( @listeners ) {
+            my ( $event, $conf ) = @$listener;
+            # XXX: Make $class and $extends work here
+            # XXX: Make $args prepend arguments to the listener
+            # XXX: Make $args also resolve refs
+            my $method = $conf->{ $meta{method} };
+            my $listen_svc = $self->get( $conf->{ $meta{ref} } );
+            $service->on( $event => sub { $listen_svc->$method( @_ ) } );
+        }
     }
 
     return $service;

diff --git a/t/14_on_event.t b/t/14_on_event.t
@@ -31,39 +31,82 @@ subtest 'single event listener' => sub {
 };
 
 subtest 'multiple event listeners' => sub {
-    my $wire = Beam::Wire->new(
-        config => {
-            emitter => {
-                class => 'My::Emitter',
-                on => {
-                    greet => [
+
+    subtest 'hash of arrays, the logical way, that we will keep' => sub {
+        my $wire = Beam::Wire->new(
+            config => {
+                emitter => {
+                    class => 'My::Emitter',
+                    on => {
+                        greet => [
+                            {
+                                '$ref' => 'listener',
+                                '$method' => 'on_greet',
+                            },
+                            {
+                                '$ref' => 'other_listener',
+                                '$method' => 'on_greet',
+                            },
+                        ],
+                    },
+                },
+                listener => {
+                    class => 'My::Listener',
+                },
+                other_listener => {
+                    class => 'My::Listener',
+                },
+            },
+        );
+
+        my $svc;
+        lives_ok { $svc = $wire->get( 'emitter' ) };
+        isa_ok $svc, 'My::Emitter';
+
+        $svc->emit( 'greet' );
+        is $wire->get( 'listener' )->events_seen, 1;
+        is $wire->get( 'other_listener' )->events_seen, 1;
+    };
+
+    subtest 'array of hashes, less logical, to get around a YAML.pm bug' => sub {
+        my $wire = Beam::Wire->new(
+            config => {
+                emitter => {
+                    class => 'My::Emitter',
+                    on => [
                         {
-                            '$ref' => 'listener',
-                            '$method' => 'on_greet',
+                            greet => {
+                                '$ref' => 'listener',
+                                '$method' => 'on_greet',
+                            },
                         },
                         {
-                            '$ref' => 'other_listener',
-                            '$method' => 'on_greet',
+                            greet => {
+                                '$ref' => 'other_listener',
+                                '$method' => 'on_greet',
+                            },
                         },
                     ],
                 },
+                listener => {
+                    class => 'My::Listener',
+                },
+                other_listener => {
+                    class => 'My::Listener',
+                },
             },
-            listener => {
-                class => 'My::Listener',
-            },
-            other_listener => {
-                class => 'My::Listener',
-            },
-        },
-    );
+        );
 
-    my $svc;
-    lives_ok { $svc = $wire->get( 'emitter' ) };
-    isa_ok $svc, 'My::Emitter';
+        my $svc;
+        lives_ok { $svc = $wire->get( 'emitter' ) };
+        isa_ok $svc, 'My::Emitter';
+
+        $svc->emit( 'greet' );
+        is $wire->get( 'listener' )->events_seen, 1;
+        is $wire->get( 'other_listener' )->events_seen, 1;
+
+    };
 
-    $svc->emit( 'greet' );
-    is $wire->get( 'listener' )->events_seen, 1;
-    is $wire->get( 'other_listener' )->events_seen, 1;
 };
 
 done_testing;