From 580261aeda80df24d181ec35d77d9b1eb11c351c Mon Sep 17 00:00:00 2001
From: miker <miker@9efc2488-bf62-4759-914b-345cdb29e865>
Date: Mon, 7 Feb 2005 20:57:43 +0000
Subject: [PATCH] updating with a new method registration and lookup mechanism

git-svn-id: svn://svn.open-ils.org/OpenSRF/trunk@25 9efc2488-bf62-4759-914b-345cdb29e865
---
 src/perlmods/OpenSRF/Application.pm | 60 ++++++++++++++---------------
 1 file changed, 28 insertions(+), 32 deletions(-)

diff --git a/src/perlmods/OpenSRF/Application.pm b/src/perlmods/OpenSRF/Application.pm
index 13f80dc..1dfeeaa 100644
--- a/src/perlmods/OpenSRF/Application.pm
+++ b/src/perlmods/OpenSRF/Application.pm
@@ -5,7 +5,7 @@ use OpenSRF::DomainObject::oilsMethod;
 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 use OpenSRF::Utils::Logger qw/:level/;
 use Time::HiRes qw/time/;
-use vars qw/$_app $log/;
+use vars qw/$_app $log %_METHODS/;
 use OpenSRF::EX qw/:try/;
 use strict;
 use warnings;
@@ -60,17 +60,6 @@ sub handler {
 			return 1;
 		}
 
-		#if ( $session->client_auth->username || $session->client_auth->userid ) {
-		#	unless ( $coderef->is_action ) {
-		#		$session->status(
-		#			OpenSRF::DomainObject::oilsMethodException->new(
-		#					statusCode => STATUS_NOTALLOWED(),
-		#					status => "User cannot use [$method_name]" ) );
-		#		return 1;
-		#	}
-		#}
-			
-
 		$log->debug( " (we got coderef $coderef", DEBUG);
 
 		unless ($session->continue_request) {
@@ -187,36 +176,43 @@ sub handler {
 	return 1;
 }
 
-sub method_lookup {
+sub register_method {
+	my $self = shift;
+	my $app = ref($self) || $self;
+	my %args = @_;
+
+	throw OpenSRF::DomainObject::oilsMethodException unless ($args{method});
+	
+	$args{protocol} ||= 1;
+	$args{api_name} ||= $app . '.' . $args{method};
+	$args{code} ||= \&{$app . '::' . $args{method}};
+	
+	$_METHODS{$args{api_name}} = bless \%args => $app;
+}
+
+
+sub method_lookup {             
 	my $self = shift;
 	my $method = shift;
 	my $proto = shift;
 
+	my $super_lookup = $self->SUPER::method_lookup($method,$proto);
+	return $super_lookup if (ref $super_lookup);
+
 	my $class = ref($self) || $self;
 
-	$log->debug("Looking up [$method] in [$self]", INTERNAL);
-	
-	my $obj = bless {} => $self;
-	if (my $coderef = $self->can("${method}_${proto}")) {
-		$$obj{code} = $coderef;
-		$$obj{name} = "${method}_${proto}";
-		return $obj;
-	}
-	return undef;
-}
+	$log->debug("Specialized lookup of [$method] in [$class]", INTERNAL);
 
-sub run {
-	my $self = shift;
-	$self->{code}->(@_);
+	if (exists $_METHODS{$method}) {
+		return $_METHODS{$method} if ($_METHODS{$method}{protocol} == $proto);
+	}               
+
+	return undef; 
 }
 
-sub is_action {
+sub run {
 	my $self = shift;
-	if (my $can = $self->can($self->{name} . '_action')) {
-		return $can->();
-	}
-	return 0;
+	$self->{code}->($self, @_);
 }
 
-
 1;
-- 
2.43.2