In a Perl daemon reacting to various events I'm trying to use a Null object pattern in 2 cases by creating anonymous subroutines, which should just return a value of 1 aka "true" (please scroll to the right to see the check subroutines for LOGIN and ALIVE events):
package User;
our %EVENTS = (
        LOGIN   => {handler => \&handleLogin,   check => sub {1},     },
        CHAT    => {handler => \&handleChat,    check => \&mayChat,   },
        JOIN    => {handler => \&handleJoin,    check => \&mayJoin,   },
        LEAVE   => {handler => \&handleLeave,   check => \&mayLeave,  },
        ALIVE   => {handler => sub {},          check => sub {1},     },
        BID     => {handler => \&handleBid,     check => \&checkArgs, },
        TAKE    => {handler => \&handleTake,    check => \&checkArgs, },
  # .... more events ....
);
sub action($$$) {
        my $user  = shift;
        my $event = shift;
        my $arg   = shift;
        my $game  = $user->{GAME};
        unless (exists $EVENTS{$event}) {
                print STDERR "wrong event: $event\n";
                return;
        }
        my $handler = $EVENTS{$event}->{handler};
        my $check   = $EVENTS{$event}->{check};
        return unless $user->$check->($arg); # XXX fails
        $user->$handler->($arg);
}
sub mayChat($$) {
        my $user = shift;
        return if $user->{KIBITZER};
}
# ...... more methods here ...
1;
Unfortunately I get the runtime error for LOGIN event:
Can't use string ("1") as a subroutine ref while "strict refs" in use
Does anybody please know how to fix it here?
How to provide a "function pointer" to an anonymous Perl subroutine?
The handler => \&sub { 1 } doesn't do it either.
Using perl 5.8.8 and perl 5.10.1 on CentOS 5.x and 6.x
UPDATE:
I've also tried following:
    my $check = $EVENTS{$event}->{check};
    return unless $check->($user, $arg);
but it doesn't help. I think this rules out the "missing blessing" suggested in some answers.
UPDATE 2:
I have extended the source code snippet in my original question. The background is: I'm in the process of refactoring of my source code and thus I've created the %EVENTS hash as listed above, so that for each incoming event (a string sent over TCP-socket from a Flash client) there is a reference to a subroutine (check) which validates the event and a reference to another subroutine (handler) which performs some actions. I'm not sure if other subroutines work - I'm stuck already at the first LOGIN event.
I also don't understand why doesn't check => sub { 1 } above work - isn't sub supposed to return a reference to an anonymous subroutine (when the name is omitted - according to perldoc perlref section 4)?
UPDATE 3:
The output of print Dumper(\%EVENTS) -
$VAR1 = {
          'PLAY' => {
                      'check' => sub { "DUMMY" },
                      'handler' => sub { "DUMMY" },
                    },
          'JOIN' => {
                      'check' => sub { "DUMMY" },
                      'handler' => sub { "DUMMY" },
                    },
          'OVER1' => {
                       'check' => sub { "DUMMY" },
                       'handler' => sub { "DUMMY" },
                     },
          'ALIVE' => {
                       'check' => sub { "DUMMY" },
                       'handler' => sub { "DUMMY" },
                     },
          'DISCARD' => {
                         'check' => $VAR1->{'PLAY'}{'check'},
                         'handler' => sub { "DUMMY" },
                       },
          'MISS1' => {
                       'check' => sub { "DUMMY" },
                       'handler' => sub { "DUMMY" },
                     },
          'LOGIN' => {
                       'check' => sub { "DUMMY" },
                       'handler' => sub { "DUMMY" },
                     },
          'TAKE' => {
                      'check' => $VAR1->{'PLAY'}{'check'},
                      'handler' => sub { "DUMMY" },
                    },
          'ONEMORE' => {
                         'check' => sub { "DUMMY" },
                         'handler' => sub { "DUMMY" },
                       },
          'OVER2' => {
                       'check' => sub { "DUMMY" },
                       'handler' => sub { "DUMMY" },
                     },
          'MISS2' => {
                       'check' => sub { "DUMMY" },
                       'handler' => sub { "DUMMY" },
                     },
          'EXACT' => {
                       'check' => sub { "DUMMY" },
                       'handler' => sub { "DUMMY" },
                     },
          'TRUST' => {
                       'check' => $VAR1->{'PLAY'}{'check'},
                       'handler' => sub { "DUMMY" },
                     },
          'LEAVE' => {
                       'check' => sub { "DUMMY" },
                       'handler' => sub { "DUMMY" },
                     },
          'DEFEND' => {
                        'check' => $VAR1->{'PLAY'}{'check'},
                        'handler' => sub { "DUMMY" },
                      },
          'OPEN' => {
                      'check' => $VAR1->{'PLAY'}{'check'},
                      'handler' => sub { "DUMMY" },
                    },
          'REVEAL' => {
                        'check' => sub { "DUMMY" },
                        'handler' => sub { "DUMMY" },
                      },
          'CHAT' => {
                      'check' => sub { "DUMMY" },
                      'handler' => sub { "DUMMY" },
                    },
          'DECLARE' => {
                         'check' => $VAR1->{'PLAY'}{'check'},
                         'handler' => sub { "DUMMY" },
                       },
          'BACK' => {
                      'check' => sub { "DUMMY" },
                      'handler' => sub { "DUMMY" },
                    },
          'MISERE' => {
                        'check' => sub { "DUMMY" },
                        'handler' => sub { "DUMMY" },
                      },
          'BID' => {
                     'check' => $VAR1->{'PLAY'}{'check'},
                     'handler' => sub { "DUMMY" },
                   }
        };
                The problem is not with the particular event that is surfacing the problem; the actual bug is in action.  In particular, the line
    return unless $user->$check->($arg); # XXX fails
doesn't do what you think it does.  Between the presence of prototypes and Perl's willingness to try and call a sub specified by name, you wind up eventually calling User:: for the CHAT event.  Which doesn't seem to be what you intended for it to do.
The more correct call looks like
    return unless $check->($user, $arg);
This expects $check to contain a subref (which it does), dereferences it and calls it.  This works even though sometimes $check will refer to a prototyped function.
That leaves the problem that this procedural code doesn't respect inheritance.  To do that, you have to rephrase %EVENTS a bit.  Thus:
our %EVENTS = (
        LOGIN   => {handler => \&handleLogin,   check => sub {1},     },
        CHAT    => {handler => \&handleChat,    check => sub { shift->mayChat(@_) },
        ...
);
Note that you are strongly discouraged to mix function prototypes and Perl OO programming precisely because it can lead to hard-to-diagnose problems like this one.
In reference to your other question:  my $foo = sub { } is indeed how you construct anonymous subroutines.  But you do need to call them appropriately.
$check is already a code reference, so you could say
return unless $check->($arg);
Your existing code could also be salvaged if $check were a reference to code that returned a code reference:
our %EVENTS = ( LOGIN => { ..., check => sub { sub { 1 } }, } ... );
Think of sub { } as a "code reference" operator the way that \ is an operator to create a scalar reference, or [...] is an operator to create an array reference.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With