services: services/perl/lib/AppSwitch/Base Service.pm

[<app...@li...>]

jgsmith     01/07/27 16:12:01

  Modified:    perl/lib/AppSwitch/Base Service.pm
  Log:
  Added Method code attribute to map subs to methods
  
  Revision  Changes    Path
  1.2       +26 -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.1
  retrieving revision 1.2
  diff -b -u -r1.1 -r1.2
  --- Service.pm	2001/07/25 21:00:30	1.1
  +++ Service.pm	2001/07/27 23:12:01	1.2
  @@ -2,9 +2,7 @@
   
   our $VERSION = 0.01;
   
  -our %METHODS = (
  -        version => q(do_version),
  -);
  +use base q(Attribute::Handlers);
   
   =head1 NAME
   
  @@ -20,9 +18,7 @@
   
    our $RPC_VERSION = "0.1";
   
  - our %METHODS = (
  -     echo => 'do_echo',
  - );
  + sub do_echo : Method(echo) { $_[2] -> {content} }
   
   =head1 DESCRIPTION
   
  @@ -74,6 +70,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.
  +
   =item $RPC_VERSION
   
   This is the version of the interface specification.  This allows clients
  @@ -143,6 +141,26 @@
       return $self;
   }
   
  +sub Method : ATTR(CODE, INIT) {
  +    my ($package, $symbol, $referent, $attr, $data) = @_;
  +
  +    no strict 'refs';
  +
  +    # if it is an anonymous sub, then map method to the code ref
  +    # if named lexical, use it as a method call on an object
  +
  +    my $value;
  +    if($symbol eq 'LEXICAL' || $symbol eq 'ANON' || !*{$symbol}{NAME}) {
  +	$value = $referent;
  +    } else {
  +	$value = *{$symbol}{NAME};
  +    }
  +
  +    $data = [ $data ] unless ref $data;
  +
  +    @{"${package}::METHODS"}{@{$data}} = ($value) x @{$data};
  +}
  +
   sub dispatch {
       my($self) = shift;
   
  @@ -152,7 +170,7 @@
   
       $code = "do_$method" unless defined $code;
   
  -    return &$code -> ($self, $method, @_)] if ref $code;
  +    return &$code -> ($self, $method, @_) if ref $code;
   
       return $self -> $code($method, @_);
   }
  @@ -175,7 +193,7 @@
       return $o;
   }
   
  -sub do_version {
  +sub do_version : Method(version) {
       my($self, $method) = @_;
   
       my $class = ref $self || $self;