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;
   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     return bless $self, $class;
  34
  35 }
  36
  37 =head2 process_request()
  38
  39  my $response = $ncip->process_request($xml);
  40
  41 =cut
  42
  43 sub process_request {
  44     my $self = shift;
  45     my $xml  = shift;
  46
  47     my $request_type = $self->handle_initiation($xml);
  48     unless ($request_type) {
  49
  50       # We have invalid xml, or we can't figure out what kind of request this is
  51       # Handle error here
  52         return;
  53
  54         #bail out for now
  55     }
  56
  57 #my $response = "<HTML> <HEAD> <TITLE>Hello There</TITLE> </HEAD> <BODY> <H1>Hello You Big JERK!</H1> Who would take this book seriously if the first eaxample didn't say \"hello world\"?  </BODY> </HTML>";
  58
  59     #return $response;
  60     warn $request_type;
  61     my $handler = NCIP::Handler->new($request_type);
  62     return $handler->handle($xml);
  63 }
  64
  65 =head2 handle_initiation
  66
  67 =cut
  68
  69 sub handle_initiation {
  70     my $self = shift;
  71     my $xml  = shift;
  72     my $dom;
  73     try {
  74         $dom = XML::LibXML->load_xml( string => $xml );
  75     }
  76     catch {
  77         warn "Invalid xml, caught error: $_";
  78     };
  79     if ($dom) {
  80
  81         # should check validity with validate at this point
  82         #        if ( $self->validate($dom) ) {
  83         my $request_type = $self->parse_request($dom);
  84
  85         # do whatever we should do to initiate, then hand back request_type
  86         if ($request_type) {
  87             return $request_type;
  88         }
  89
  90         #       }
  91         #       else {
  92         #            warn "Not valid xml";
  93         # not valid throw error
  94         #           return;
  95         #       }
  96
  97     }
  98     else {
  99         return;
 100     }
 101 }
 102
 103 sub validate {
 104
 105     # this should perhaps be in it's own module
 106     my $self     = shift;
 107     my $dom      = shift;
 108     my $validity = $dom->is_valid();
 109
 110     # we could validate against the dtd here, might be good?
 111     # my $dtd = XML::LibXML::Dtd->parse_string($dtd_str);
 112     # my $validity = $dom->is_valid($dtd);
 113     # perhaps we could check the ncip version and validate that too
 114     return $validity;
 115 }
 116
 117 sub parse_request {
 118     my $self  = shift;
 119     my $dom   = shift;
 120     my $nodes = $dom->getElementsByTagNameNS( $nsURI, 'NCIPMessage' );
 121     if ($nodes) {
 122         my @childnodes = $nodes->[0]->childNodes();
 123         if ( $childnodes[1] ) {
 124             return $childnodes[1]->localname();
 125         }
 126         else {
 127             return;
 128         }
 129     }
 130     else {
 131         warn "Invalid XML";
 132         return 0;
 133     }
 134     return 0;
 135 }
 136
 137 1;