lib/NCIP.pm

   1 package NCIP;
   2 use NCIP::Configuration;
   3 use NCIP::Handler;
   4 use Modern::Perl;
   5 use XML::LibXML;
   6 use Try::Tiny;
   7
   8 use Object::Tiny qw{xmldoc config namespace};
   9
  10 our $VERSION = '0.01';
  11 our $nsURI   = 'http://www.niso.org/2008/ncip';
  12
  13 =head1 NAME
  14
  15     NCIP
  16
  17 =head1 SYNOPSIS
  18
  19     use NCIP;
  20     my $nicp = NCIP->new($config_dir);
  21
  22 =head1 FUNCTIONS
  23
  24 =cut
  25
  26 sub new {
  27     my $proto      = shift;
  28     my $class      = ref $proto || $proto;
  29     my $config_dir = shift;
  30     my $self       = {};
  31     my $config     = NCIP::Configuration->new($config_dir);
  32     $self->{config}    = $config;
  33     $self->{namespace} = $nsURI;
  34     return bless $self, $class;
  35
  36 }
  37
  38 =head2 process_request()
  39
  40  my $response = $ncip->process_request($xml);
  41
  42 =cut
  43
  44 sub process_request {
  45     my $self = shift;
  46     my $xml  = shift;
  47
  48     my ($request_type) = $self->handle_initiation($xml);
  49     unless ($request_type) {
  50
  51       # We have invalid xml, or we can't figure out what kind of request this is
  52       # Handle error here
  53         return;
  54
  55         #bail out for now
  56     }
  57     my $handler = NCIP::Handler->new( $self->namespace(), $request_type );
  58     return $handler->handle( $self->xmldoc );
  59 }
  60
  61 =head2 handle_initiation
  62
  63 =cut
  64
  65 sub handle_initiation {
  66     my $self = shift;
  67     my $xml  = shift;
  68     my $dom;
  69     try {
  70         $dom = XML::LibXML->load_xml( string => $xml );
  71     }
  72     catch {
  73         warn "Invalid xml, caught error: $_";
  74     };
  75     if ($dom) {
  76
  77         # should check validity with validate at this point
  78         if ( $self->validate($dom) ) {
  79             my $request_type = $self->parse_request($dom);
  80
  81             # do whatever we should do to initiate, then hand back request_type
  82             if ($request_type) {
  83                 $self->{xmldoc} = $dom;
  84                 return $request_type;
  85             }
  86         }
  87         else {
  88             warn "Not valid xml";
  89
  90             # not valid throw error
  91             return;
  92         }
  93     }
  94     else {
  95         return;
  96     }
  97 }
  98
  99 sub validate {
 100
 101     # this should perhaps be in it's own module
 102     my $self = shift;
 103     my $dom  = shift;
 104     try {
 105         $dom->validate();
 106     }
 107     catch {
 108         warn "Bad xml, caught error: $_";
 109         return;
 110     };
 111
 112     # we could validate against the dtd here, might be good?
 113     # my $dtd = XML::LibXML::Dtd->parse_string($dtd_str);
 114     # $dom->validate($dtd);
 115     # perhaps we could check the ncip version and validate that too
 116     return 1;
 117 }
 118
 119 sub parse_request {
 120     my $self  = shift;
 121     my $dom   = shift;
 122     my $nodes = $dom->getElementsByTagNameNS( $nsURI, 'NCIPMessage' );
 123     if ($nodes) {
 124         my @childnodes = $nodes->[0]->childNodes();
 125         if ( $childnodes[1] ) {
 126             return $childnodes[1]->localname();
 127         }
 128         else {
 129             return;
 130         }
 131     }
 132     else {
 133         warn "Invalid XML";
 134         return;
 135     }
 136     return;
 137 }
 138
 139 1;