Continuing work on NCIP.pm
[working/NCIPServer.git] / 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;