lib/NCIP.pm

   1 package NCIP;
   2 use NCIP::Configuration;
   3 use NCIP::Response;
   4 use NCIP::Problem;
   5 use Modern::Perl;
   6 use XML::LibXML;
   7 use XML::LibXML::Simple qw/XMLin/;
   8 use Try::Tiny;
   9 use Module::Load;
  10 use Template;
  11 use Log::Log4perl;
  12
  13 use Object::Tiny qw{config namespace ils};
  14
  15 our $VERSION           = '0.01';
  16 our $strict_validation = 0;        # move to config file
  17
  18 =head1 NAME
  19
  20     NCIP
  21
  22 =head1 SYNOPSIS
  23
  24     use NCIP;
  25     my $nicp = NCIP->new($config_dir);
  26
  27 =head1 FUNCTIONS
  28
  29 =cut
  30
  31 sub new {
  32     my $proto      = shift;
  33     my $class      = ref $proto || $proto;
  34     my $config_dir = shift;
  35     my $self       = {};
  36     my $config     = NCIP::Configuration->new($config_dir);
  37     $self->{config}    = $config;
  38     $self->{namespace} = $config->('NCIP.namespace.value');
  39     Log::Log4perl->init($config_dir . "/log4perl.conf");
  40     # load the ILS dependent module
  41     my $module = $config->('NCIP.ils.value');
  42     load $module || die "Can not load ILS module $module";
  43     my $ils = $module->new( name => $config->('NCIP.ils.value') );
  44     $self->{'ils'} = $ils;
  45     return bless $self, $class;
  46
  47 }
  48
  49 =head2 process_request()
  50
  51  my $output = $ncip->process_request($xml);
  52
  53 =cut
  54
  55 sub process_request {
  56     my $self           = shift;
  57     my $xml            = shift;
  58
  59     # Declare our response object:
  60     my $response;
  61
  62     # Make an object out of the XML request message:
  63     my $request = $self->handle_initiation($xml);
  64     if ($request) {
  65         # Get the request type from the message:
  66         my $type = $self->{ils}->parse_request_type($request);
  67         if ($type) {
  68             my $message = lc($type);
  69             if ($self->{ils}->can($message)) {
  70                 $response = $self->{ils}->$message($request);
  71             } else {
  72                 $response = $self->{ils}->unsupportedservice($request);
  73             }
  74         }
  75     }
  76
  77     # The ILS is responsible for handling internal errors, so we
  78     # assume that not having a response object at this point means we
  79     # got an invalid message sent to us, or it got garbled in
  80     # transmission.
  81     unless ($response) {
  82         my $problem = NCIP::Problem->new();
  83         $problem->ProblemType("Invalid Message Syntax Error");
  84         $problem->ProblemDetail("Unable to parse the NCIP message.");
  85         $problem->ProblemElement("NULL");
  86         $problem->ProblemValue("Unable to parse the NCIP message.");
  87         # Make a response and add our problem.
  88         $response = NCIP::Response->new();
  89         $response->problem($problem);
  90     }
  91
  92     return $self->render_output($response);
  93 }
  94
  95 =head2 handle_initiation
  96
  97 =cut
  98
  99 sub handle_initiation {
 100     my $self = shift;
 101     my $xml  = shift;
 102
 103     my $dom;
 104     my $log = Log::Log4perl->get_logger("NCIP");
 105
 106     eval { $dom = XML::LibXML->load_xml( string => $xml ); };
 107     if ($@) {
 108         $log->info("Invalid xml we can not parse it ");
 109     }
 110     if ($dom) {
 111
 112         # should check validity with validate at this point
 113         if ( $strict_validation && !$self->validate($dom) ) {
 114
 115             # we want strict validation, bail out if dom doesnt validate
 116 #            warn " Not valid xml";
 117
 118             # throw/log error
 119             return;
 120         }
 121         return XMLin( $dom, NsStrip => 1, NormaliseSpace => 2 );
 122     }
 123     else {
 124         $log->info("We have no DOM");
 125
 126         return;
 127     }
 128 }
 129
 130 sub validate {
 131
 132     # this should perhaps be in it's own module
 133     my $self = shift;
 134     my $dom  = shift;
 135     try {
 136         $dom->validate();
 137     }
 138     catch {
 139         warn "Bad xml, caught error: $_";
 140         return;
 141     };
 142
 143     # we could validate against the schema here, might be good?
 144     # my $schema = XML::LibXML::Schema->new(string => $schema_str);
 145     # eval { $schema->validate($dom); }
 146     # perhaps we could check the ncip version and validate that too
 147     return 1;
 148 }
 149
 150 =head2 render_output
 151
 152   my $output = $self->render_output($response);
 153
 154 Accepts a NCIP::Response object and renders the response.tt template
 155 based on its input.  The template output is returned.
 156
 157 =cut
 158
 159 sub render_output {
 160     my $self         = shift;
 161     my $response = shift;
 162
 163     my $template = Template->new(
 164         {
 165             INCLUDE_PATH => $self->config->('NCIP.templates.value'),
 166             POST_CHOMP   => 1
 167         }
 168     );
 169
 170     my $output;
 171     $template->process( 'response.tt', $response, \$output );
 172     return $output;
 173 }
 174
 175 1;