Re: Subclassing a class that uses an internal dispatch table

package Net::SMTP::Server::Client2::MySubClass;
use strict;
use vars qw/@ISA/;
use Net::SMTP::Server::Client2;
@isa = qw/Net::SMTP::Server::Client2/;

my %private_commands = ( HELO => \&my_hello,
                         [...]
                       );

sub new {
   my ($class, $sock) = @_;
   my $self = $class->SUPER::new($sock);
   bless $self, __PACKAGE__;
}

[...]

sub get_message {
   my ($self, $cmd, @args) = @_;
   return $self->SUPER::get_message($cmd, @args) unless exists $privat
+e_commands{$cmd};
   # from here on mimic the super class's method, but with 
   # calls to your private, "overridden" methods.

}

sub my_hello {
   # perform some individual stuff.
}
[download]

--------------------------------
masses are the opiate for religion.

Comment on Re: Subclassing a class that uses an internal dispatch table Download Code

Replies are listed 'Best First'.
Re^2: Subclassing a class that uses an internal dispatch table by BrowserUk (Patriarch) on Oct 30, 2007 at 03:53 UTC
I think you may have misread the source code of Client2. The variables `$cmd, @args` are not input parameters to `get_message()` but rather just local variable declarations: `sub get_message { my $self = shift; my($cmd, @args); ...` [download] That doesn't negate your method, but does require you to modify the dispatching to check your dispatch table before dispatching any non-overridden methods to the superclass at the bottom of the read loop rather than at the top of the sub. Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice. "Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."	[reply] [d/l] [select]
Re^3: Subclassing a class that uses an internal dispatch table by TOD (Friar) on Oct 30, 2007 at 06:30 UTC
yes, you're right. both `$cmd` and `@args` will be received through the socket. hmm... what about this one: #!/usr/bin/perl -w { package Net::SMTP::Server::Client2::Subclass; use strict; use vars qw/@ISA/; use Net::SMTP::Server::Client2; @ISA = qw/Net::SMTP::Server::Client2/; my %_pcmds = ( HELO => \do { print STDERR "hello\n" } ); our $eval_command = sub { my ($self, $cmd, @args) = @_; my $hash = (__PACKAGE__ =~ /Subclass$/) ? '$_pcmds' : '$ +_cmds'; $cmd = "&{$hash"."{$cmd}}(\$self, \\\@args)"; eval $cmd or return(defined($self->{MSG})); }; &Net::SMTP::Server::Client2::eval_command = \$eval_command; sub new { my ($class, $sock) = @_; my $self = $class->SUPER::new($sock); bless $self, __PACKAGE__; } sub get_message { my $self = shift; my ($cmd, @args); # [...} # do everything the super class does, up to this point: if (exists $_pcmds{$cmd}) { $eval_command->($self, $cmd, @args); } else { $self->SUPER::eval_command($cmd, @args); } } 1; } [download] i've never done that before, but at least the compiler doesn't complain. -------------------------------- masses are the opiate for religion.	[reply] [d/l] [select]