bf239108e428d0412aa1c267aa9c5ea481c8923d
[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 use Template;
9
10 use Object::Tiny qw{xmldoc config namespace ils};
11
12 our $VERSION           = '0.01';
13 our $strict_validation = 0;        # move to config file
14
15 =head1 NAME
16   
17     NCIP
18
19 =head1 SYNOPSIS
20
21     use NCIP;
22     my $nicp = NCIP->new($config_dir);
23
24 =head1 FUNCTIONS
25
26 =cut
27
28 sub new {
29     my $proto      = shift;
30     my $class      = ref $proto || $proto;
31     my $config_dir = shift;
32     my $self       = {};
33     my $config     = NCIP::Configuration->new($config_dir);
34     $self->{config}    = $config;
35     $self->{namespace} = $config->('NCIP.namespace.value');
36
37     # load the ILS dependent module
38     my $module = 'NCIP::ILS::' . $config->('NCIP.ils.value');
39     load $module || die "Can not load ILS module $module";
40     my $ils = $module->new( name => $config->('NCIP.ils.value') );
41     $self->{'ils'} = $ils;
42     return bless $self, $class;
43
44 }
45
46 =head2 process_request()
47
48  my $response = $ncip->process_request($xml);
49
50 =cut
51
52 sub process_request {
53     my $self           = shift;
54     my $xml            = shift;
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         my $output = $self->_error("We can't find request type");
62         return $output;
63     }
64     my $handler = NCIP::Handler->new(
65         {
66             namespace    => $self->namespace(),
67             type         => $request_type,
68             ils          => $self->ils,
69             template_dir => $self->config->('NCIP.templates.value'),
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     eval { $dom = XML::LibXML->load_xml( string => $xml ); };
84     if ($@) {
85         warn "Invalid xml, caught error: $@";
86     }
87     if ($dom) {
88
89         # should check validity with validate at this point
90         if ( $strict_validation && !$self->validate($dom) ) {
91
92             # we want strict validation, bail out if dom doesnt validate
93 #            warn " Not valid xml";
94
95             # throw/log error
96             return;
97         }
98         my $request_type = $self->parse_request($dom);
99
100         # do whatever we should do to initiate, then hand back request_type
101         if ($request_type) {
102             $self->{xmldoc} = $dom;
103             return $request_type;
104         }
105     }
106     else {
107         warn "We have no DOM";
108
109         return;
110     }
111 }
112
113 sub validate {
114
115     # this should perhaps be in it's own module
116     my $self = shift;
117     my $dom  = shift;
118     try {
119         $dom->validate();
120     }
121     catch {
122         warn "Bad xml, caught error: $_";
123         return;
124     };
125
126     # we could validate against the dtd here, might be good?
127     # my $dtd = XML::LibXML::Dtd->parse_string($dtd_str);
128     # $dom->validate($dtd);
129     # perhaps we could check the ncip version and validate that too
130     return 1;
131 }
132
133 sub parse_request {
134     my $self = shift;
135     my $dom  = shift;
136     my $nodes =
137       $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             warn "Got a node, but no child node";
145             return;
146         }
147     }
148     else {
149         warn "Invalid XML";
150         return;
151     }
152     return;
153 }
154
155 sub _error {
156     my $self         = shift;
157     my $error_detail = shift;
158     my $vars;
159     $vars->{'error_detail'} = $error_detail;
160     $vars->{'messagetype'} = 'ItemRequestedResponse'; # No idea what this type should be 
161     my $template = Template->new(
162         { INCLUDE_PATH => $self->config->('NCIP.templates.value'), } );
163     my $output;
164     $template->process( 'problem.tt', $vars, \$output );
165     return $output;
166 }
167 1;