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

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

jgsmith     01/07/25 14:00:30

  Added:       perl/lib/AppSwitch/Base Service.pm
  Log:
  Initial commit
  
  Revision  Changes    Path
  1.1                  services/perl/lib/AppSwitch/Base/Service.pm
  
  Index: Service.pm
  ===================================================================
  package AppSwitch::Base::Service;
  
  our $VERSION = 0.01;
  
  our %METHODS = (
          version => q(do_version),
  );
  
  =head1 NAME
  
  AppSwitch::Base::Service;
  
  =head1 SYNOPSIS
  
   my $handler = initialize My::Service $daemon;
  
   package My::Service;
  
   use base q(AppSwitch::Base::Service);
  
   our $RPC_VERSION = "0.1";
  
   our %METHODS = (
       echo => 'do_echo',
   );
  
  =head1 DESCRIPTION
  
  This module provides the basic glue between the service daemon 
  and the service handler, which is derived from this module.
  
  =head1 METHODS
  
  =over 4
  
  =item dispatch($method, @args)
  
  It is this method that actually calls the working code for the service
  daemon.  The called function will have the service handler object and
  the method name as the first two arguments followed by C<@args>.
  
  If the method is not defined in the package global C<%METHODS>,
  then a default method name of C<do_$method> is assumed.
  
  =item initialize($daemon)
  
  This method creates a handler object and registers it with the service
  daemon.  This method also walks the C<@ISA> tree and collects all the
  pre-defined methods.  Note that modifications to the C<%METHODS> globals
  will not affect the method table after initialization.
  
  =item set_method($method, $code)
  
  This method will associate either a method name or a code reference with a
  method in the service handler's dispatch table.  The previous value,
  if any, is returned.
  
  =item remove_method($method)
  
  This method will remove a method from the service handler's dispatch table.
  The previous value, if any, is returned.
  
  =back
  
  =head1 GLOBALS
  
  =over 4
  
  =item %METHODS
  
  This hash contains a mapping of method names to either code references or
  object method names.  The C<initialize> method will walk the C<@ISA> tree
  and merge all C<%METHODS> hashes, with method mappings closer to the object
  class having precedence.  The tree is walked depth-first in imitation of
  Perl's handling of the C<@ISA> array for class inheritance.
  
  =item $RPC_VERSION
  
  This is the version of the interface specification.  This allows clients
  and switches to know what capabilities to expect.
  
  =back
  
  =head1 AUTHOR
  
  James Smith <jg...@ja...>
  
  =head1 SEE ALSO
  
  L<AppSwitch::Base::Client>.
  
  =head1 COPYRIGHT
  
  Copyright (C) 2001  James Smith
  
  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions
  are met:
  
  1. Redistributions of source code must retain the above copyright
  notice, this list of conditions and the following disclaimer.
  
  2. Redistributions in binary form must reproduce the above copyright
  notice, this list of conditions and the following disclaimer in the
  documentation and/or other materials provided with the distribution.
  
  3. Neither the name of the Project nor the names of its contributors
  may be used to endorse or promote products derived from this
  software without specific prior written permission.
  
  =cut
  
  sub initialize {
      my $class = shift;
  
      $class = ref $class || $class;
  
      my $self = bless { }, $class;
  
      # $class tells us where to start looking for methods...
      # assume we are using SOAP::Lite or XMLRPC::Lite
      my $daemon = shift;
  
      my @classes = ( $class );
  
      my %methods;
  
      while(@classes) {
  	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};
  	    }
  	}
      }
  
      $self -> {dispatch} = \%methods;
  
      $daemon -> register($self);
  
      return $self;
  }
  
  sub dispatch {
      my($self) = shift;
  
      my($method) = shift;
  
      my($code) = $self -> {dispatch} -> {$mthod};
  
      $code = "do_$method" unless defined $code;
  
      return &$code -> ($self, $method, @_)] if ref $code;
  
      return $self -> $code($method, @_);
  }
  
  sub set_method {
      my($self, $method, $coderef) = @_;
  
      my $o = $self -> {dispatch} -> {$method};
  
      $self -> {dispatch} -> {$method} = $coderef;
  
      return $o;
  }
  
  sub remove_method {
      my($self, $method) = @_;
  
      my $o = $self -> {dispatch} -> {$method};
      delete $self -> {dispatch} -> {$method};
      return $o;
  }
  
  sub do_version {
      my($self, $method) = @_;
  
      my $class = ref $self || $self;
  
      my @classes = ($class);
  
      while(@classes) {
  	my $c = shift;
  	unshift @classes, @{"${c}::ISA"} if defined @{"${c}::ISA"};
  	if(defined ${"${c}::RPC_VERSION"}) {
  	    return "1." . ${"${c}::RPC_VERSION"};
  	}
      }
  
      return "1.0.0";
  }
  
  1;