From db3cebc939e8cef8b40b0c0c60e67800d077419d Mon Sep 17 00:00:00 2001 From: Jason Stephenson Date: Fri, 8 Aug 2014 15:01:23 -0400 Subject: [PATCH] Prepare NCIP.pm and NCIP/ILS.pm for removal of Handler.pm and cousins. This moves the rendering of template output from Handler.pm to NCIP.pm. We also add another useful method, parse_request_type to NCIP::ILS. Along the way, we go from parsing the XML message with XPath to using XML::LibXML::Simple. Signed-off-by: Jason Stephenson --- lib/NCIP.pm | 118 +++++++++++++++++++++++++++++--------------------------- lib/NCIP/ILS.pm | 33 +++++++++------- 2 files changed, 81 insertions(+), 70 deletions(-) diff --git a/lib/NCIP.pm b/lib/NCIP.pm index c5425f6..bc61682 100644 --- a/lib/NCIP.pm +++ b/lib/NCIP.pm @@ -1,14 +1,16 @@ package NCIP; use NCIP::Configuration; -use NCIP::Handler; +use NCIP::Response; +use NCIP::Problem; use Modern::Perl; use XML::LibXML; +use XML::LibXML::Simple qw/XMLin/; use Try::Tiny; use Module::Load; use Template; use Log::Log4perl; -use Object::Tiny qw{xmldoc config namespace ils}; +use Object::Tiny qw{config namespace ils}; our $VERSION = '0.01'; our $strict_validation = 0; # move to config file @@ -46,31 +48,48 @@ sub new { =head2 process_request() - my $response = $ncip->process_request($xml); + my $output = $ncip->process_request($xml); =cut sub process_request { my $self = shift; my $xml = shift; - my ($request_type) = $self->handle_initiation($xml); - unless ($request_type) { - - # We have invalid xml, or we can't figure out what kind of request this is - # Handle error here -# warn "We can't find request type"; - my $output = $self->_error("We can't find request type"); - return $output; - } - my $handler = NCIP::Handler->new( - { - namespace => $self->namespace(), - type => $request_type, - ils => $self->ils, - template_dir => $self->config->('NCIP.templates.value'), + + # Declare our response object: + my $response; + + # Make an object out of the XML request message: + my $request = $self->handle_initiation($xml); + if ($request) { + # Get the request type from the message: + my $type = $self->{ils}->parse_request_type($request); + if ($type) { + my $message = lc($type); + if ($self->{ils}->can($message)) { + $response = $self->{ils}->$message($request); + } else { + $response = $self->{ils}->unsupportedservice($request); + } } - ); - return $handler->handle( $self->xmldoc ); + } + + # The ILS is responsible for handling internal errors, so we + # assume that not having a response object at this point means we + # got an invalid message sent to us, or it got garbled in + # transmission. + unless ($response) { + my $problem = NCIP::Problem->new(); + $problem->ProblemType("Invalid Message Syntax Error"); + $problem->ProblemDetail("Unable to parse the NCIP message."); + $problem->ProblemElement("NULL"); + $problem->ProblemValue("Unable to parse the NCIP message."); + # Make a response and add our problem. + $response = NCIP::Response->new(); + $response->problem($problem); + } + + return $self->render_output($response); } =head2 handle_initiation @@ -80,11 +99,13 @@ sub process_request { sub handle_initiation { my $self = shift; my $xml = shift; + my $dom; my $log = Log::Log4perl->get_logger("NCIP"); + eval { $dom = XML::LibXML->load_xml( string => $xml ); }; if ($@) { - $log->info("Invalid xml we can not parse it "); + $log->info("Invalid xml we can not parse it "); } if ($dom) { @@ -97,13 +118,7 @@ sub handle_initiation { # throw/log error return; } - my $request_type = $self->parse_request($dom); - - # do whatever we should do to initiate, then hand back request_type - if ($request_type) { - $self->{xmldoc} = $dom; - return $request_type; - } + return XMLin( $dom, NsStrip => 1, NormaliseSpace => 2 ); } else { $log->info("We have no DOM"); @@ -132,38 +147,29 @@ sub validate { return 1; } -sub parse_request { - my $self = shift; - my $dom = shift; - my $nodes = - $dom->getElementsByTagNameNS( $self->namespace(), 'NCIPMessage' ); - if ($nodes) { - my @childnodes = $nodes->[0]->childNodes(); - if ( $childnodes[1] ) { - return $childnodes[1]->localname(); - } - else { - warn "Got a node, but no child node"; - return; - } - } - else { - warn "Invalid XML"; - return; - } - return; -} +=head2 render_output + + my $output = $self->render_output($response); + +Accepts a NCIP::Response object and renders the response.tt template +based on its input. The template output is returned. -sub _error { +=cut + +sub render_output { my $self = shift; - my $error_detail = shift; - my $vars; - $vars->{'error_detail'} = $error_detail; - $vars->{'messagetype'} = 'ItemRequestedResponse'; # No idea what this type should be + my $response = shift; + my $template = Template->new( - { INCLUDE_PATH => $self->config->('NCIP.templates.value'), } ); + { + INCLUDE_PATH => $self->config->('NCIP.templates.value'), + POST_CHOMP => 1 + } + ); + my $output; - $template->process( 'problem.tt', $vars, \$output ); + $template->process( 'response.tt', $response, \$output ); return $output; } + 1; diff --git a/lib/NCIP/ILS.pm b/lib/NCIP/ILS.pm index 9c6715e..ce5f551 100644 --- a/lib/NCIP/ILS.pm +++ b/lib/NCIP/ILS.pm @@ -112,13 +112,7 @@ sub unsupportedservice { my $self = shift; my $request = shift; - my $service; - for my $key (keys %$request) { - if (ref $request->{$key} eq 'HASH') { - $service = $key; - last; - } - } + my $service = $self->parse_request_type($request); my $response = NCIP::Response->new({type => $service . 'Response'}); my $problem = NCIP::Problem->new(); @@ -143,13 +137,9 @@ sub make_header { my $initheader; my $header; - for my $key (keys %$request) { - if (ref $request->{$key} eq 'HASH' - && $request->{$key}->{InitiationHeader}) { - $initheader = $request->{$key}->{InitiationHeader}; - last; - } - } + my $key = $self->parse_request_type($request); + $initheader = $request->{$key}->{InitiationHeader} + if ($key && $request->{$key}->{InitiationHeader}); if ($initheader && $initheader->{FromAgencyId} && $initheader->{ToAgencyId}) { @@ -162,4 +152,19 @@ sub make_header { return $header; } +sub parse_request_type { + my $self = shift; + my $request = shift; + my $type; + + for my $key (keys %$request) { + if (ref $request->{$key} eq 'HASH') { + $type = $key; + last; + } + } + + return $type; +} + 1; -- 2.11.0