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