appswitch-commits Mailing List for Application Switch
Status: Pre-Alpha
Brought to you by:
jgsmith
Menu
▾
▴
appswitch-commits — All CVS commits are posted to this list as context diffs.
You can subscribe to this list here.
| 2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(34) |
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
|
|---|
|
From: <app...@li...> - 2001-08-01 04:58:43
|
jgsmith 01/07/31 21:58:42
Modified: perl/lib/AppSwitch/Base Client.pm Service.pm
Log:
Updated for importing and XMLRPC::Lite use...
Revision Changes Path
1.5 +8 -2 services/perl/lib/AppSwitch/Base/Client.pm
Index: Client.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Base/Client.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -b -u -r1.4 -r1.5
--- Client.pm 2001/07/29 18:25:35 1.4
+++ Client.pm 2001/08/01 04:58:42 1.5
@@ -3,10 +3,16 @@
our $VERSION = 0.01;
use Carp;
-use XMLRPC::Transport::UNIX;
+use XMLRPC::Lite;
use strict;
-# $Id: Client.pm,v 1.4 2001/07/29 18:25:35 jgsmith Exp $
+# $Id: Client.pm,v 1.5 2001/08/01 04:58:42 jgsmith Exp $
+
+sub import {
+ no strict q(refs);
+
+ *{caller() . "::object_or_default"} = \&object_or_default;
+}
=head1 NAME
1.5 +1 -0 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.4
retrieving revision 1.5
diff -b -u -r1.4 -r1.5
--- Service.pm 2001/07/29 18:26:58 1.4
+++ Service.pm 2001/08/01 04:58:42 1.5
@@ -125,6 +125,7 @@
my %methods;
while(@classes) {
+ no strict 'refs';
my $c = shift;
unshift @classes, @{"${c}::ISA"} if defined @{"${c}::ISA"};
if(defined %{"${c}::METHODS"}) {
|
|
From: <app...@li...> - 2001-08-01 04:54:32
|
jgsmith 01/07/31 21:54:31
Added: perl/lib/AppSwitch/Authenticate Client.pm Service.pm
Log:
Initial commit
Revision Changes Path
1.1 services/perl/lib/AppSwitch/Authenticate/Client.pm
Index: Client.pm
===================================================================
package AppSwitch::Authenticate::Client;
use base q(AppSwitch::Base::Client);
use strict;
our $VERSION = q(0.01);
{
no warnings;
our $RPC_SERVICE = "authenticate";
}
sub user_add {
my($self, $domain, $username, $password) = object_or_default(@_);
return $self -> request("user_add", (
domain => $domain,
username => $username,
password => $password
) );
}
sub user_delete {
my($self, $domain, $username) = object_or_default(@_);
return $self -> request("user_delete", (
domain => $domain,
username => $username
) );
}
sub user_exists {
my($self, $domain, $username) = object_or_default(@_);
return $self -> request("user_exists", (
domain => $domain,
username => $username
) );
}
sub user_authenticate {
my($self, $domain, $username, $password) = object_or_default(@_);
return $self -> request("user_authenticate", (
domain => $domain,
username => $username,
password => $password
) );
}
sub ticket_authenticate {
my($self, $domain, $ticket) = object_or_default(@_);
return $self -> request("ticket_authenticate", (
domain => $domain,
ticket => $ticket
) );
}
1;
__END__
=head1 NAME
AppSwitch::Authenticate::Client
=head1 SYNOPSIS
use AppSwitch::Authenticate::Client;
$bool = user_add($domain, $username, $password);
$bool = user_exists($domain, $username);
$ticket = user_authenticate($domain, $username, $password);
$bool = user_delete($domain, $username);
$ticket = ticket_authenticate($domain, $ticket);
=head1 DESCRIPTION
The authenticate client and server provide a fairly complete interface to
an authentication database.
The authentication model allows for repeat authentication without
requiring the username and password each time. Once a ticket is available,
it may be authenticated with the C<ticket_authenticate> method, which will
return a new ticket if the previous one was valid. This allows tickets to
be passed between sites without the danger of simple replay attacks with a
ticket. C<ticket_authenticate> will only return a ticket once per ticket.
=head1 METHODS
=over 4
=item ticket_authenticate(domain, ticket)
This method will return a new ticket if the given ticket is valid. A
ticket should only be used once.
=item user_add(domain, username, password)
This method will try to add a username with the given password to the
domain. Note that C<user_exists> may return false for some usernames that
do not succeed with C<user_add>. C<user_exists> cannot be used as a test
for usernames that are reserved but do not represent valid authentication
accounts.
=item user_authenticate(domain, username, password)
This method will return true iff the username and password are valid in the
given domain.
=item user_delete(domain, username)
This method will try to delete the username from the given domain.
=item user_exists(domain, username)
This method will return true iff the username represents a valid
username/password in the domain. That is, given the proper password,
C<user_authenticate> will return true for this user.
=back
=head1 AUTHOR
James Smith <jg...@ja...>
=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.
1.1 services/perl/lib/AppSwitch/Authenticate/Service.pm
Index: Service.pm
===================================================================
package AppSwitch::Authenticate::Service;
use base q{AppSwitch::Base::Service};
use strict;
our $VERSION = 0.01;
sub do_user_add : Method(user_add) {
die "Unable to add users\n";
}
sub do_user_delete : Method(user_delete) {
die "Unable to delete users\n";
}
sub do_user_exists : Method(user_exists) {
die "Unable to determine existance of user\n";
}
sub do_user_authenticate : Method(user_authenticate) {
die "Unable to authenticate user\n";
}
sub do_ticket_authenticate : Method(ticket_authenticate) {
die "Unable to determine authenticity of ticket\n";
}
1;
__END__
=head1 NAME
AppSwitch::Authenticate::Service;
=head1 SYNOPSIS
my $handler = initialize My::Authenticate::Service $daemon;
=head1 DESCRIPTION
This module provides an authentication service (authenticate.*).
Proper use of this module requires the creation of a subclass. Any of the
following methods may be redefined to avoid the default error behavior.
do_user_add
do_user_delete
do_user_exists
do_user_authenticate
do_ticket_authenticate
=head1 AUTHOR
James Smith <jg...@ja...>
=head1 SEE ALSO
L<AppSwitch::Base::Service>,
L<AppSwitch::Authenticate::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.
|
|
From: <app...@li...> - 2001-08-01 04:54:12
|
jgsmith 01/07/31 21:54:11 services/perl/lib/AppSwitch/Authenticate - New directory |
|
From: <app...@li...> - 2001-07-30 01:38:09
|
jgsmith 01/07/29 18:38:09
Modified: perl/lib/AppSwitch/Services Daemon.pm
Log:
Added support for aliasing services -- foo.bar. should be able to handle
requests in the foo. namespace.
Revision Changes Path
1.2 +10 -2 services/perl/lib/AppSwitch/Services/Daemon.pm
Index: Daemon.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Services/Daemon.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -b -u -r1.1 -r1.2
--- Daemon.pm 2001/07/29 18:17:23 1.1
+++ Daemon.pm 2001/07/30 01:38:09 1.2
@@ -8,11 +8,13 @@
sub register {
my($self, $handler) = @_;
- $self -> {handler} -> {handlers} -> {$handler -> service} = $handler;
+ $self -> set_handler($handler -> service, $handler);
}
sub query_handler { $_[0] -> {handler} -> {handlers} -> {$_[1]} }
+sub set_handler { $_[0] -> {handler} -> {handlers} -> {$_[1]} = $_[2] }
+
sub run {
my($self) = @_;
@@ -56,6 +58,12 @@
my($service, $method) = (lc($1), lc($2));
return undef unless defined $self -> {handlers} -> {$service};
+
+ while($service && !ref($self -> {handlers} -> {$service})) {
+ $service = $self -> {handlers} -> {$service};
+ }
+
+ return undef unless $service && defined $self -> {handlers} -> {$service};
*$m = sub { shift -> {handlers} -> {$service} -> dispatch($method, @_) };
|
|
From: <app...@li...> - 2001-07-30 01:18:01
|
jgsmith 01/07/29 18:18:00
Modified: perl/t daemon.t
Log:
Generalized tests so we can add more service modules without too much
trouble...
Revision Changes Path
1.2 +14 -6 services/perl/t/daemon.t
Index: daemon.t
===================================================================
RCS file: /cvsroot/appswitch/services/perl/t/daemon.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -b -u -r1.1 -r1.2
--- daemon.t 2001/07/30 01:04:29 1.1
+++ daemon.t 2001/07/30 01:18:00 1.2
@@ -1,6 +1,10 @@
-use Test::Simple tests => 5;
-
BEGIN {
+ @services = qw(Echo);
+
+ $number_tests = 3 + 2 * @services;
+
+ eval "use Test::Simple tests => $number_tests;";
+
sub load {
foreach my $m (@_) {
@@ -12,15 +16,19 @@
load(qw(AppSwitch::Services::Daemon AppSwitch::Base::Service));
}
-load(qw(AppSwitch::Echo::Service)
- );
+# tests 3..(2+@services)
+load(map { "AppSwitch::${_}::Service" } @services);
my $daemon;
eval { $daemon = new AppSwitch::Services::Daemon(LocalPort=>1234) };
+# test 3+@services
ok($@ eq "", "Create service daemon" . ($@ eq "" ? "" : " : $@"));
-eval { initialize $daemon q(Echo) };
+# tests 4+@services .. 3+2*@services
+foreach(@services) {
+ eval { initialize $daemon $_ };
-ok($@ eq "", "Initialize Echo service" . ($@ eq "" ? "" : " : $@"));
+ ok($@ eq "", "Initialize $_ service" . ($@ eq "" ? "" : " : $@"));
+}
|
|
From: <app...@li...> - 2001-07-30 01:04:30
|
jgsmith 01/07/29 18:04:29
Added: perl/t client.t daemon.t
Log:
Initial commit of testing scripts
Revision Changes Path
1.1 services/perl/t/client.t
Index: client.t
===================================================================
use Test::Simple tests => 2;
sub load {
foreach my $m (@_) {
eval "require $m";
ok($@ eq "", "Loaded $m" . ($@ eq "" ? "" : " : $@"));
}
}
load(
qw(AppSwitch::Base::Client AppSwitch::Echo::Client)
);
1.1 services/perl/t/daemon.t
Index: daemon.t
===================================================================
use Test::Simple tests => 5;
BEGIN {
sub load {
foreach my $m (@_) {
eval "require $m";
ok($@ eq "", "Loaded $m" . ($@ eq "" ? "" : " : $@"));
}
}
load(qw(AppSwitch::Services::Daemon AppSwitch::Base::Service));
}
load(qw(AppSwitch::Echo::Service)
);
my $daemon;
eval { $daemon = new AppSwitch::Services::Daemon(LocalPort=>1234) };
ok($@ eq "", "Create service daemon" . ($@ eq "" ? "" : " : $@"));
eval { initialize $daemon q(Echo) };
ok($@ eq "", "Initialize Echo service" . ($@ eq "" ? "" : " : $@"));
|
|
From: <app...@li...> - 2001-07-30 01:04:04
|
jgsmith 01/07/29 18:04:03 services/perl/t - New directory |
|
From: <app...@li...> - 2001-07-29 18:28:24
|
jgsmith 01/07/29 11:28:24 Modified: perl/lib/AppSwitch Echo.pm Log: Reflects the modified Echo spec Revision Changes Path 1.2 +2 -2 services/perl/lib/AppSwitch/Echo.pm Index: Echo.pm =================================================================== RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Echo.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -b -u -r1.1 -r1.2 --- Echo.pm 2001/07/20 14:45:24 1.1 +++ Echo.pm 2001/07/29 18:28:24 1.2 @@ -2,7 +2,7 @@ our $VERSION = q(0.01); -# $Id: Echo.pm,v 1.1 2001/07/20 14:45:24 jgsmith Exp $ +# $Id: Echo.pm,v 1.2 2001/07/29 18:28:24 jgsmith Exp $ __END__ @@ -34,7 +34,7 @@ =item echo.echo -This method returns the value of its single argument (C<content>). +This method returns the arguments unmodified. =back |
|
From: <app...@li...> - 2001-07-29 18:27:13
|
jgsmith 01/07/29 11:27:13
Modified: perl/lib/AppSwitch/Echo Client.pm Service.pm
Log:
Reflect updated Echo spec
Revision Changes Path
1.4 +5 -7 services/perl/lib/AppSwitch/Echo/Client.pm
Index: Client.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Echo/Client.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -b -u -r1.3 -r1.4
--- Client.pm 2001/07/29 05:12:31 1.3
+++ Client.pm 2001/07/29 18:27:13 1.4
@@ -11,9 +11,9 @@
}
sub echo {
- my($self, $string) = object_or_default(@_);
+ my($self, %args) = object_or_default(@_);
- return $self -> request("echo", content => $string);
+ return $self -> request("echo", %args);
}
1;
@@ -28,10 +28,8 @@
use AppSwitch::Echo::Client;
-my $client = new AppSwitch::Echo::Client;
+print echo(content => 'Hello, World!') -> {content};
-print $client -> echo('Hello, World!');
-
=head1 DESCRIPTION
The echo client and server provide a simple example of a service
@@ -42,9 +40,9 @@
=over 4
-=item echo(string)
+=item echo(hash)
-Uses an echo service to return the string sent to the service.
+Uses an echo service to return the hash sent to the service.
This can be useful for testing connections or making sure the
daemon is up and running.
1.5 +1 -1 services/perl/lib/AppSwitch/Echo/Service.pm
Index: Service.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Echo/Service.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -b -u -r1.4 -r1.5
--- Service.pm 2001/07/29 05:12:31 1.4
+++ Service.pm 2001/07/29 18:27:13 1.5
@@ -5,7 +5,7 @@
our $VERSION = 0.01;
-sub do_echo : Method(echo) { $_[2] -> {content} }
+sub do_echo : Method(echo) { $_[2] }
1;
|
|
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;
|
|
From: <app...@li...> - 2001-07-29 18:25:35
|
jgsmith 01/07/29 11:25:35
Modified: perl/lib/AppSwitch/Base Client.pm
Log:
Changed to XML-RPC for now
Revision Changes Path
1.4 +4 -7 services/perl/lib/AppSwitch/Base/Client.pm
Index: Client.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Base/Client.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -b -u -r1.3 -r1.4
--- Client.pm 2001/07/29 05:12:31 1.3
+++ Client.pm 2001/07/29 18:25:35 1.4
@@ -3,10 +3,10 @@
our $VERSION = 0.01;
use Carp;
-use SOAP::Transport::UNIX;
+use XMLRPC::Transport::UNIX;
use strict;
-# $Id: Client.pm,v 1.3 2001/07/29 05:12:31 jgsmith Exp $
+# $Id: Client.pm,v 1.4 2001/07/29 18:25:35 jgsmith Exp $
=head1 NAME
@@ -125,18 +125,15 @@
sub request {
- my($self) = shift;
+ my($self, $method, %args) = @_;
- my $method = shift;
- my(%args) = @_;
-
$method = $self -> service() . ".$method";
# now we need to dispatch via the SOAP/XML-RPC client object... which is global...
our $_client;
if(!defined $_client) {
- $_client = SOAP::Lite -> proxy("unix:$ENV{APPSWITCH_SOCKET}")
+ $_client = XMLRPC::Lite -> proxy("unix:$ENV{APPSWITCH_SOCKET}")
or croak "Unable to connect to AppSwitch daemon: $!";
}
|
|
From: <app...@li...> - 2001-07-29 18:17:23
|
jgsmith 01/07/29 11:17:23
Added: perl/lib/AppSwitch/Services Daemon.pm
Log:
Initial commit
Revision Changes Path
1.1 services/perl/lib/AppSwitch/Services/Daemon.pm
Index: Daemon.pm
===================================================================
package AppSwitch::Services::Daemon;
use strict;
use XMLRPC::Transport::HTTP;
our $VERSION = q(0.01);
sub register {
my($self, $handler) = @_;
$self -> {handler} -> {handlers} -> {$handler -> service} = $handler;
}
sub query_handler { $_[0] -> {handler} -> {handlers} -> {$_[1]} }
sub run {
my($self) = @_;
$self -> {daemon} = XMLRPC::Transport::HTTP::Daemon
-> new (%{$self -> {config} || {}})
-> dispatch_to($self -> {handler})
-> handle();
}
sub new {
my($class) = shift;
$class = ref $class || $class;
my $self = bless { config => { @_ },
handler => bless { } =>
q(AppSwitch::Services::Daemon::Handler),
} => $class;
return $self;
}
sub initialize {
my($self, $m) = shift;
foreach(@_) {
$m = m{::} ? $_ : "AppSwitch::${_}::Service";
eval { require $m; };
$m -> initialize($self) unless $@;
}
}
package AppSwitch::Services::Daemon::Handler;
sub AUTOLOAD {
my($self) = shift;
# SOAP::Lite likes the methods to be object methods for some odd reason
(my $m = our $AUTOLOAD) =~ s{^.*::}{};
return undef unless $m =~ m{(.+)\.(.+)};
my($service, $method) = (lc($1), lc($2));
return undef unless defined $self -> {handlers} -> {$service};
*$m = sub { shift -> {handlers} -> {$service} -> dispatch($method, @_) };
goto &$m;
}
1;
__END__
=head1 NAME
AppSwitch::Services::Daemon
=head1 SYNOPSIS
my $daemon = new AppSwitch::Services::Daemon [Configuration...];
initialize $daemon q(Echo Authentication My::Authorization);
my $echo_handler = $daemon -> query_handler("echo");
$daemon -> run();
=head1 DESCRIPTION
The service daemon runs the XML-RPC server providing the actual services.
Setup is quite simple, with an arbitrary number of services supported.
The actual XMLRPC::Transport::HTTP daemon is configured by the
information passed when creating the AppSwitch::Services::Daemon
object.
=head1 AUTHOR
James Smith <jg...@ja...>
=head1 SEE ALSO
L<XMLRPC::Transport::HTTP>.
=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
|
|
From: <app...@li...> - 2001-07-29 18:16:05
|
jgsmith 01/07/29 11:16:04 services/perl/lib/AppSwitch/Services - New directory |
|
From: <app...@li...> - 2001-07-29 05:12:32
|
jgsmith 01/07/28 22:12:31
Modified: perl/lib/AppSwitch/Echo Client.pm Service.pm
Log:
Added `use strict' and made so they can compile with warnings turned on
Revision Changes Path
1.3 +5 -1 services/perl/lib/AppSwitch/Echo/Client.pm
Index: Client.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Echo/Client.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -b -u -r1.2 -r1.3
--- Client.pm 2001/07/27 23:21:35 1.2
+++ Client.pm 2001/07/29 05:12:31 1.3
@@ -1,10 +1,14 @@
package AppSwitch::Echo::Client;
use base q(AppSwitch::Base::Client);
+use strict;
our $VERSION = q(0.01);
-our $RPC_SERVICE = "echo";
+{
+ no warnings;
+ our $RPC_SERVICE = "echo";
+}
sub echo {
my($self, $string) = object_or_default(@_);
1.4 +1 -0 services/perl/lib/AppSwitch/Echo/Service.pm
Index: Service.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Echo/Service.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -b -u -r1.3 -r1.4
--- Service.pm 2001/07/27 22:59:45 1.3
+++ Service.pm 2001/07/29 05:12:31 1.4
@@ -1,6 +1,7 @@
package AppSwitch::Echo::Service;
use base q{AppSwitch::Base::Service};
+use strict;
our $VERSION = 0.01;
|
|
From: <app...@li...> - 2001-07-29 05:12:32
|
jgsmith 01/07/28 22:12:31
Modified: perl/lib/AppSwitch/Base Client.pm Service.pm
Log:
Added `use strict' and made so they can compile with warnings turned on
Revision Changes Path
1.3 +5 -4 services/perl/lib/AppSwitch/Base/Client.pm
Index: Client.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Base/Client.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -b -u -r1.2 -r1.3
--- Client.pm 2001/07/27 23:26:28 1.2
+++ Client.pm 2001/07/29 05:12:31 1.3
@@ -4,8 +4,9 @@
use Carp;
use SOAP::Transport::UNIX;
+use strict;
-# $Id: Client.pm,v 1.2 2001/07/27 23:26:28 jgsmith Exp $
+# $Id: Client.pm,v 1.3 2001/07/29 05:12:31 jgsmith Exp $
=head1 NAME
@@ -132,7 +133,7 @@
$method = $self -> service() . ".$method";
# now we need to dispatch via the SOAP/XML-RPC client object... which is global...
- our $_transport;
+ our $_client;
if(!defined $_client) {
$_client = SOAP::Lite -> proxy("unix:$ENV{APPSWITCH_SOCKET}")
@@ -156,9 +157,9 @@
sub object_or_default {
- return @_ if ref $_[0] && $_[0] -> isa(AppSwitch::Base::Client);
+ return @_ if ref $_[0] && $_[0] -> isa('AppSwitch::Base::Client');
my $caller = caller;
- our $_clients;
+ our %_clients;
$_clients{$caller} = $caller -> new() unless defined $_clients{$caller};
return ($_clients{$caller}, @_);
}
1.3 +2 -1 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.2
retrieving revision 1.3
diff -b -u -r1.2 -r1.3
--- Service.pm 2001/07/27 23:12:01 1.2
+++ Service.pm 2001/07/29 05:12:31 1.3
@@ -3,6 +3,7 @@
our $VERSION = 0.01;
use base q(Attribute::Handlers);
+use strict;
=head1 NAME
@@ -166,7 +167,7 @@
my($method) = shift;
- my($code) = $self -> {dispatch} -> {$mthod};
+ my($code) = $self -> {dispatch} -> {$method};
$code = "do_$method" unless defined $code;
|
|
From: <app...@li...> - 2001-07-27 23:26:29
|
jgsmith 01/07/27 16:26:28
Modified: perl/lib/AppSwitch/Base Client.pm
Log:
Allow functional use of client interfaces
Revision Changes Path
1.2 +19 -2 services/perl/lib/AppSwitch/Base/Client.pm
Index: Client.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Base/Client.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -b -u -r1.1 -r1.2
--- Client.pm 2001/07/20 20:54:09 1.1
+++ Client.pm 2001/07/27 23:26:28 1.2
@@ -5,7 +5,7 @@
use Carp;
use SOAP::Transport::UNIX;
-# $ Id: $
+# $Id: Client.pm,v 1.2 2001/07/27 23:26:28 jgsmith Exp $
=head1 NAME
@@ -146,8 +146,25 @@
}
}
+=item object_or_default
+This will return all the arguments with the first argument guarenteed to be
+a valid client object.
+=cut
+
+
+
+sub object_or_default {
+ return @_ if ref $_[0] && $_[0] -> isa(AppSwitch::Base::Client);
+ my $caller = caller;
+ our $_clients;
+ $_clients{$caller} = $caller -> new() unless defined $_clients{$caller};
+ return ($_clients{$caller}, @_);
+}
+
+
+
=item version
This will return the version of the service provider. If
@@ -159,7 +176,7 @@
sub version {
- my($self) = shift;
+ my($self) = object_or_default(@_);
return $self -> request("version");
}
|
|
From: <app...@li...> - 2001-07-27 23:21:36
|
jgsmith 01/07/27 16:21:35
Modified: perl/lib/AppSwitch/Echo Client.pm
Log:
Use support routine to support functional model
Revision Changes Path
1.2 +1 -3 services/perl/lib/AppSwitch/Echo/Client.pm
Index: Client.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Echo/Client.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -b -u -r1.1 -r1.2
--- Client.pm 2001/07/20 20:58:01 1.1
+++ Client.pm 2001/07/27 23:21:35 1.2
@@ -7,9 +7,7 @@
our $RPC_SERVICE = "echo";
sub echo {
- my($self) = shift;
-
- my($string) = $_
+ my($self, $string) = object_or_default(@_);
return $self -> request("echo", content => $string);
}
|
|
From: <app...@li...> - 2001-07-27 23:12:01
|
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;
|
|
From: <app...@li...> - 2001-07-27 22:59:46
|
jgsmith 01/07/27 15:59:45
Modified: perl/lib/AppSwitch/Echo Service.pm
Log:
Change to use Method subroutine attribute
Revision Changes Path
1.3 +1 -5 services/perl/lib/AppSwitch/Echo/Service.pm
Index: Service.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Echo/Service.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -b -u -r1.2 -r1.3
--- Service.pm 2001/07/26 05:49:19 1.2
+++ Service.pm 2001/07/27 22:59:45 1.3
@@ -4,11 +4,7 @@
our $VERSION = 0.01;
-our %METHODS = (
- echo => q(do_echo),
-);
-
-sub do_echo { $_[2] -> {content} }
+sub do_echo : Method(echo) { $_[2] -> {content} }
1;
|
|
From: <app...@li...> - 2001-07-26 05:49:20
|
jgsmith 01/07/25 22:49:19
Modified: perl/lib/AppSwitch/Echo Service.pm
Log:
Moved the module to one contiguous block of code
Revision Changes Path
1.2 +6 -6 services/perl/lib/AppSwitch/Echo/Service.pm
Index: Service.pm
===================================================================
RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Echo/Service.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -b -u -r1.1 -r1.2
--- Service.pm 2001/07/25 22:19:49 1.1
+++ Service.pm 2001/07/26 05:49:19 1.2
@@ -8,6 +8,12 @@
echo => q(do_echo),
);
+sub do_echo { $_[2] -> {content} }
+
+1;
+
+__END__
+
=head1 NAME
AppSwitch::Echo::Service;
@@ -47,9 +53,3 @@
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 do_echo { $_[2] -> {content} }
-
-1;
|
|
From: <app...@li...> - 2001-07-25 22:19:50
|
jgsmith 01/07/25 15:19:49
Added: perl/lib/AppSwitch/Echo Service.pm
Log:
Initial commit
Revision Changes Path
1.1 services/perl/lib/AppSwitch/Echo/Service.pm
Index: Service.pm
===================================================================
package AppSwitch::Echo::Service;
use base q{AppSwitch::Base::Service};
our $VERSION = 0.01;
our %METHODS = (
echo => q(do_echo),
);
=head1 NAME
AppSwitch::Echo::Service;
=head1 SYNOPSIS
my $handler = initialize AppSwitch::Echo::Service $daemon;
=head1 DESCRIPTION
This module provides an echo service.
=head1 AUTHOR
James Smith <jg...@ja...>
=head1 SEE ALSO
L<AppSwitch::Base::Service>,
L<AppSwitch::Echo::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 do_echo { $_[2] -> {content} }
1;
|
|
From: <app...@li...> - 2001-07-25 21:12:32
|
jgsmith 01/07/25 14:12:31 Modified: perl/lib/AppSwitch Services.pm Log: Added reference to AppSwitch::Base and better reference to AppSwitch::Echo. Revision Changes Path 1.2 +9 -1 services/perl/lib/AppSwitch/Services.pm Index: Services.pm =================================================================== RCS file: /cvsroot/appswitch/services/perl/lib/AppSwitch/Services.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -b -u -r1.1 -r1.2 --- Services.pm 2001/07/20 14:45:24 1.1 +++ Services.pm 2001/07/25 21:12:31 1.2 @@ -33,9 +33,17 @@ =item echo -This is an echo service provided by the AppSwitch::Echo packages. +This is an echo service described by L<AppSwitch::Echo>. =back + +=head1 AUTHOR + +James Smith <jg...@ja...> + +=head1 SEE ALSO + +L<AppSwitch::Base>. =head1 COPYRIGHT |
|
From: <app...@li...> - 2001-07-25 21:09:54
|
jgsmith 01/07/25 14:09:53
Added: perl/lib/AppSwitch Base.pm
Log:
Initial commit
Revision Changes Path
1.1 services/perl/lib/AppSwitch/Base.pm
Index: Base.pm
===================================================================
package AppSwitch::Base;
our $VERSION = q(0.01);
# $Id: Base.pm,v 1.1 2001/07/25 21:09:53 jgsmith Exp $
__END__
=head1 NAME
AppSwitch::Base
=head1 SYNOPSIS
use AppSwitch::Base::Client;
use AppSwitch::Base::Server;
=head1 DESCRIPTION
AppSwitch::Base provides the client and service interfaces for
services. Actual interface classes should be derived from this class.
This class should not be used alone.
=head1 AUTHOR
James Smith <jg...@ja...>
=head1 SEE ALSO
L<AppSwitch::Base::Client>,
L<AppSwitch::Base::Server>
=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
|
|
From: <app...@li...> - 2001-07-25 21:00:31
|
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;
|
|
From: <app...@li...> - 2001-07-22 00:39:16
|
jgsmith 01/07/21 17:39:16
Modified: perl Makefile.PL
Log:
Added prereqs needed for AppSwitch::Config
Revision Changes Path
1.2 +3 -0 daemon/perl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /cvsroot/appswitch/daemon/perl/Makefile.PL,v
retrieving revision 1.1
retrieving revision 1.2
diff -b -u -r1.1 -r1.2
--- Makefile.PL 2001/07/20 04:03:54 1.1
+++ Makefile.PL 2001/07/22 00:39:16 1.2
@@ -4,5 +4,8 @@
WriteMakefile(
'NAME' => 'AppSwitch::Daemon',
'VERSION_FROM' => 'lib/AppSwitch/Daemon.pm', # finds $VERSION
+ PREREQ_PM => { XML::Parser => 2.30,
+ XML::Parser::EasyTree => 0.01,
+ },
'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" },
);
|
