Perl libs for OpenSRF ingress tracking

Ingress is a free-form text value which represents the entry point for
the client into the opensrf network.  The value is passed within opensrf
messages, similar to "locale".  Clients should specify the ingress
before any opensrf communication occurs.

OpenSRF::AppSession->ingress($ingress);

Stock values include the following:

opensrf (default)
srfsh
translator-v1
gateway-v1

Signed-off-by: Bill Erickson <berick@esilibrary.com>

diff --git a/src/perl/lib/OpenSRF/AppSession.pm b/src/perl/lib/OpenSRF/AppSession.pm
index c8ee269..d19085f 100644 (file)
--- a/src/perl/lib/OpenSRF/AppSession.pm
+++ b/src/perl/lib/OpenSRF/AppSession.pm
@@ -22,6 +22,13 @@ our %EXPORT_TAGS = ( state => [ qw/CONNECTING INIT_CONNECTED CONNECTED DISCONNEC
 
 my $logger = "OpenSRF::Utils::Logger";
 my $_last_locale = 'en-US';
+our $current_ingress = 'opensrf';
+
+sub ingress {
+    my ($class, $ingress) = @_;
+    $current_ingress = $ingress if $ingress;
+    return $current_ingress;
+}
 
 our %_CACHE;
 our @_RESEND_QUEUE;
@@ -499,6 +506,8 @@ sub send {
 
         my $locale = $self->session_locale;
                $msg->sender_locale($locale) if ($locale);
+
+               $msg->sender_ingress($current_ingress);
        
                push @doc, $msg;
 

diff --git a/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm b/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
index 44eafc2..54c5963 100644 (file)
--- a/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
+++ b/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
@@ -102,6 +102,24 @@ sub sender_locale {
        return $self->{locale};
 }
 
+=head2 OpenSRF::DomainObject::oilsMessage->sender_ingress( [$ingress] );
+
+=over 4
+
+Sets or gets the current message ingress.  Useful for telling the
+server how you entered the opensrf network.
+
+=back
+
+=cut
+
+sub sender_ingress {
+       my $self = shift;
+       my $val = shift;
+       $self->{ingress} = $val if $val;
+       return $self->{ingress};
+}
+
 =head2 OpenSRF::DomainObject::oilsMessage->threadTrace( [$new_threadTrace] );
 
 =over 4
@@ -180,10 +198,11 @@ sub handler {
 
        my $mtype = $self->type;
        my $locale = $self->sender_locale || '';
+       my $ingress = $self->sender_ingress || '';
        my $api_level = $self->api_level || 1;
        my $tT = $self->threadTrace;
 
-    $log->debug("Message locale is $locale", DEBUG);
+    $log->debug("Message locale is $locale; ingress = $ingress", DEBUG);
 
        $session->last_message_type($mtype);
        $session->last_message_api_level($api_level);

diff --git a/src/perl/lib/OpenSRF/Transport.pm b/src/perl/lib/OpenSRF/Transport.pm
index cfb7ba9..c295acd 100644 (file)
--- a/src/perl/lib/OpenSRF/Transport.pm
+++ b/src/perl/lib/OpenSRF/Transport.pm
@@ -153,6 +153,8 @@ sub handler {
 
                next unless (   $msg && UNIVERSAL::isa($msg => 'OpenSRF::DomainObject::oilsMessage'));
 
+               OpenSRF::AppSession->ingress($msg->sender_ingress);
+
                if( $app_session->endpoint == $app_session->SERVER() ) {
 
                        try {