moving to tag: URIs
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / WWW / SuperCat.pm
1 package OpenILS::WWW::SuperCat;
2 use strict; use warnings;
3
4 use Apache2 ();
5 use Apache2::Log;
6 use Apache2::Const -compile => qw(OK REDIRECT DECLINED :log);
7 use APR::Const    -compile => qw(:error SUCCESS);
8 use Apache2::RequestRec ();
9 use Apache2::RequestIO ();
10 use Apache2::RequestUtil;
11 use CGI;
12 use Data::Dumper;
13
14 use OpenSRF::EX qw(:try);
15 use OpenSRF::System;
16 use OpenSRF::AppSession;
17 use XML::LibXML;
18
19 use OpenILS::Utils::Fieldmapper;
20
21
22 # set the bootstrap config when this module is loaded
23 my ($bootstrap, $supercat);
24
25 sub import {
26         my $self = shift;
27         $bootstrap = shift;
28 }
29
30
31 sub child_init {
32         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
33         $supercat = OpenSRF::AppSession->create('open-ils.supercat');
34 }
35
36 sub oisbn {
37
38         my $apache = shift;
39         return Apache2::Const::DECLINED if (-e $apache->filename);
40
41         (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
42
43         my $list = $supercat
44                 ->request("open-ils.supercat.oisbn", $isbn)
45                 ->gather(1);
46
47         print "Content-type: application/xml; charset=utf-8\n\n";
48         print "<?xml version='1.0' encoding='UTF-8' ?>\n";
49
50         unless (exists $$list{metarecord}) {
51                 print '<idlist/>';
52                 return Apache2::Const::OK;
53         }
54
55         print "<idlist metarecord='$$list{metarecord}'>\n";
56
57         for ( keys %{ $$list{record_list} } ) {
58                 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
59                 print "  <isbn record='$_'>$o</isbn>\n"
60         }
61
62         print "</idlist>\n";
63
64         return Apache2::Const::OK;
65 }
66
67 sub unapi {
68
69         my $apache = shift;
70         return Apache2::Const::DECLINED if (-e $apache->filename);
71
72         print "Content-type: application/xml; charset=utf-8\n";
73         
74         my $cgi = new CGI;
75
76         my $uri = $cgi->param('uri') || '';
77         my $base = $cgi->url;
78         my $host = $cgi->virtual_host || $cgi->server_name;
79
80         my $format = $cgi->param('format');
81         my ($id,$type,$command) = ('','','');
82
83         if (!$format) {
84                 if ($uri =~ m{^tag:[^:]+:([^\/]+)/(\d+)}o) {
85                         $id = $2;
86                         $type = 'record';
87                         $type = 'metarecord' if ($1 =~ /^m/o);
88
89                         my $list = $supercat
90                         ->request("open-ils.supercat.$type.formats")
91                                 ->gather(1);
92
93                         print "\n";
94
95                         my $body =
96                                 "<formats>
97                                  <uri>$uri</uri>
98                                    <format>
99                                      <name>opac</name>
100                                      <type>text/html</type>
101                                    </format>";
102
103                         for my $h (@$list) {
104                                 my ($type) = keys %$h;
105                                 $body .= "<format><name>$type</name><type>application/$type+xml</type>";
106
107                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
108                                         $body .= "<$part>$$h{$type}{$part}</$part>"
109                                                 if ($$h{$type}{$part});
110                                 }
111                                 
112                                 $body .= '</format>';
113                         }
114
115                         $body .= "</formats>\n";
116
117                         $apache->custom_response( 300, $body);
118                         return 300;
119                 } else {
120                         my $list = $supercat
121                                 ->request("open-ils.supercat.record.formats")
122                                 ->gather(1);
123                                 
124                         push @$list,
125                                 @{ $supercat
126                                         ->request("open-ils.supercat.metarecord.formats")
127                                         ->gather(1);
128                                 };
129
130                         my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
131                         $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
132
133                         print "\n<formats>
134                                    <format>
135                                      <name>opac</name>
136                                      <type>text/html</type>
137                                    </format>";
138
139                         for my $h (@$list) {
140                                 my ($type) = keys %$h;
141                                 print "<format><name>$type</name><type>application/$type+xml</type>";
142
143                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
144                                         print "<$part>$$h{$type}{$part}</$part>"
145                                                 if ($$h{$type}{$part});
146                                 }
147                                 
148                                 print '</format>';
149                         }
150
151                         print "</formats>\n";
152
153
154                         return Apache2::Const::OK;
155                 }
156         }
157
158                 
159         if ($uri =~ m{^tag:[^:]+:([^\/]+)/(\d+)}o) {
160                 $id = $2;
161                 $type = 'record';
162                 $type = 'metarecord' if ($1 =~ /^m/o);
163                 $command = 'retrieve';
164         }
165
166         if ($format eq 'opac') {
167                 print "Location: $base/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
168                         if ($type eq 'metarecord');
169                 print "Location: $base/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
170                         if ($type eq 'record');
171                 return 302;
172         }
173
174         print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
175
176         return Apache2::Const::OK;
177 }
178
179 sub supercat {
180
181         my $apache = shift;
182         return Apache2::Const::DECLINED if (-e $apache->filename);
183
184         my $path = $apache->path_info;
185
186         my $cgi = new CGI;
187         my $base = $cgi->url;
188
189         my ($id,$type,$format,$command) = reverse split '/', $path;
190
191         print "Content-type: application/xml; charset=utf-8\n";
192         
193         if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
194                 if ($1) {
195                         my $list = $supercat
196                                 ->request("open-ils.supercat.$1.formats")
197                                 ->gather(1);
198
199                         print "\n";
200
201                         print "<formats>
202                                    <format>
203                                      <name>opac</name>
204                                      <type>text/html</type>
205                                    </format>";
206
207                         for my $h (@$list) {
208                                 my ($type) = keys %$h;
209                                 print "<format><name>$type</name><type>application/$type+xml</type>";
210
211                                 for my $part ( qw/namespace_uri docs schema_location/ ) {
212                                         print "<$part>$$h{$type}{$part}</$part>"
213                                                 if ($$h{$type}{$part});
214                                 }
215                                 
216                                 print '</format>';
217                         }
218
219                         print "</formats>\n";
220
221                         return Apache2::Const::OK;
222                 }
223
224                 my $list = $supercat
225                         ->request("open-ils.supercat.record.formats")
226                         ->gather(1);
227                                 
228                 push @$list,
229                         @{ $supercat
230                                 ->request("open-ils.supercat.metarecord.formats")
231                                 ->gather(1);
232                         };
233
234                 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
235                 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
236
237                 print "\n<formats>
238                            <format>
239                              <name>opac</name>
240                              <type>text/html</type>
241                            </format>";
242
243                 for my $h (@$list) {
244                         my ($type) = keys %$h;
245                         print "<format><name>$type</name><type>application/$type+xml</type>";
246
247                         for my $part ( qw/namespace_uri docs schema_location/ ) {
248                                 print "<$part>$$h{$type}{$part}</$part>"
249                                         if ($$h{$type}{$part});
250                         }
251                         
252                         print '</format>';
253                 }
254
255                 print "</formats>\n";
256
257
258                 return Apache2::Const::OK;
259         }
260
261         if ($format eq 'opac') {
262                 print "Location: $base/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
263                         if ($type eq 'metarecord');
264                 print "Location: $base/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
265                         if ($type eq 'record');
266                 return 302;
267         }
268
269         print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
270
271         return Apache2::Const::OK;
272 }
273
274 1;