services: services/perl/lib/AppSwitch/Base Service.pm
Status: Pre-Alpha
Brought to you by:
jgsmith
|
From: <app...@li...> - 2001-07-29 18:26:59
|
jgsmith 01/07/29 11:26:58
Modified: perl/lib/AppSwitch/Base Service.pm
Log:
Reflect updated Echo spec
Revision Changes Path
1.4 +8 -8 services/perl/lib/AppSwitch/Base/Service.pm
Index: Service.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Base/Service.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -b -u -r1.3 -r1.4
--- Service.pm 2001/07/29 05:12:31 1.3
+++ Service.pm 2001/07/29 18:26:58 1.4
@@ -19,7 +19,7 @@
our $RPC_VERSION = "0.1";
- sub do_echo : Method(echo) { $_[2] -> {content} }
+ sub do_echo : Method(echo) { $_[2] }
=head1 DESCRIPTION
@@ -71,7 +71,8 @@
class having precedence. The tree is walked depth-first in imitation of
Perl's handling of the C<@ISA> array for class inheritance.
-The C<Method(method(s))> subroutine attribute should be used to mark methods.
+The C<Method(method)> or C<Methods(methods)> subroutine attribute
+should be used to mark methods.
=item $RPC_VERSION
@@ -110,7 +111,7 @@
=cut
sub initialize {
- my $class = shift;
+ my($class, $daemon) = @_;
$class = ref $class || $class;
@@ -118,7 +119,6 @@
# $class tells us where to start looking for methods...
# assume we are using SOAP::Lite or XMLRPC::Lite
- my $daemon = shift;
my @classes = ( $class );
@@ -128,12 +128,10 @@
my $c = shift;
unshift @classes, @{"${c}::ISA"} if defined @{"${c}::ISA"};
if(defined %{"${c}::METHODS"}) {
- foreach my $k (keys %{"${c}::METHODS"}) {
- $methods{$k} = ${"${c}::METHODS"}{$k}
- unless defined $methods{$k};
+ my @k = grep { ! defined $methods{$_} } keys %{"${c}::METHODS"};
+ @methods{@k} = @{"${c}::METHODS"}{@k} if @k;
}
}
- }
$self -> {dispatch} = \%methods;
@@ -161,6 +159,8 @@
@{"${package}::METHODS"}{@{$data}} = ($value) x @{$data};
}
+
+sub Methods : ATTR(CODE, INIT) { &Method }
sub dispatch {
my($self) = shift;
|