lib/NCIP.pm

   1 package NCIP;
   2 use NCIP::Configuration;
   3 use Modern::Perl;
   4 use XML::LibXML;
   5 use Try::Tiny;
   6
   7 use base qw(Class::Accessor);
   8
   9 our $VERSION = '0.01';
  10
  11 =head1 NAME
  12
  13     NCIP
  14
  15 =head1 SYNOPSIS
  16
  17     use NCIP;
  18     my $nicp = NCIP->new($config_dir);
  19
  20 =head1 FUNCTIONS
  21
  22 =cut
  23
  24 sub new {
  25     my $proto      = shift;
  26     my $class      = ref $proto || $proto;
  27     my $config_dir = shift;
  28     my $self       = {};
  29     my $config     = NCIP::Configuration->new($config_dir);
  30     $self->{config} = $config;
  31     return bless $self, $class;
  32
  33 }
  34
  35 =head2 process_request()
  36
  37  my $response = $ncip->process_request($xml);
  38
  39 =cut
  40
  41 sub process_request {
  42     my $self = shift;
  43     my $xml  = shift;
  44
  45     my $request_type = $self->handle_initiation($xml);
  46     unless ($request_type) {
  47
  48       # We have invalid xml, or we can't figure out what kind of request this is
  49       # Handle error here
  50     }
  51
  52 #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>";
  53
  54     #return $response;
  55     return $request_type;
  56 }
  57
  58 =head2 handle_initiation
  59
  60 =cut
  61
  62 sub handle_initiation {
  63     my $self = shift;
  64     my $xml  = shift;
  65     my $dom;
  66     try {
  67         $dom = XML::LibXML->load_xml( string => $xml );
  68     }
  69     catch {
  70         warn "Invalid xml, caught error: $_";
  71     };
  72     if ($dom) {
  73
  74         # should check validity with validate at this point
  75         my $request_type = $self->parse_request($dom);
  76         return $request_type;
  77     }
  78     else {
  79         return;
  80     }
  81 }
  82
  83 sub validate {
  84
  85     # this should perhaps be in it's own module
  86     my $self     = shift;
  87     my $dom      = shift;
  88     my $validity = $dom->is_valid();
  89
  90     # we could validate against the dtd here, might be good?
  91     # my $dtd = XML::LibXML::Dtd->parse_string($dtd_str);
  92     # my $validity = $dom->is_valid($dtd);
  93     # perhaps we could check the ncip version and validate that too
  94     return $validity;
  95 }
  96
  97 sub parse_request {
  98     my $self  = shift;
  99     my $dom   = shift;
 100     my $nodes = $dom->findnodes('/*');
 101     if ( $nodes->[0]->nodeName() ne 'ns1:NCIPMessage' ) {
 102
 103         # we don't have a valid ncip message
 104         # bail out
 105         warn "bad xml";
 106     }
 107     else {
 108         my @childnodes = $nodes->[0]->childNodes();
 109
 110         # the second child should be the type of request
 111         if ( $childnodes[1] && $childnodes[1]->nodeName =~ /ns1\:(.*)/ ) {
 112             return $1;
 113         }
 114         else {
 115             # just while developing return not found
 116             return ('Not_found');
 117         }
 118     }
 119
 120     return 0;
 121 }
 122
 123 1;