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

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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;

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

appswitch-commits