renamed 'biblios' directory for webservices to 'svc'
[wip/koha-chris_n.git] / svc / bib
1 #!/usr/bin/perl
2
3 # Copyright 2007 LibLime
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19 #
20
21 use strict;
22 use CGI;
23 use C4::Auth qw/check_api_auth/;
24 use C4::Biblio;
25 use XML::Simple;
26
27 my $query = new CGI;
28
29 my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 1} );
30 unless ($status eq "ok") {
31     print $query->header(-type => 'text/xml', -status => '403 Forbidden');
32     print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
33     exit 0;
34 }
35
36 # do initial validation
37 my $path_info = $query->path_info();
38
39 my $biblionumber = undef;
40 if ($path_info =~ m!^/(\d+)$!) {
41     $biblionumber = $1;
42 } else {
43     print $query->header(-type => 'text/xml', -status => '400 Bad Request');
44 }
45
46 # are we retrieving or updating a bib?
47 if ($query->request_method eq "GET") {
48     fetch_bib($query, $biblionumber);
49 } else {
50     update_bib($query, $biblionumber);
51 }
52
53 exit 0;
54
55 sub fetch_bib {
56     my $query = shift;
57     my $biblionumber = shift;
58     my $record = GetMarcBiblio($biblionumber);
59     if  (defined $record) {
60         print $query->header(-type => 'text/xml');
61         print $record->as_xml_record();
62     } else {
63         print $query->header(-type => 'text/xml', -status => '404 Not Found');
64     }
65 }
66
67 sub update_bib {
68     my $query = shift;
69     my $biblionumber = shift;
70     my $old_record = GetMarcBiblio($biblionumber);
71     unless  (defined $old_record) {
72         print $query->header(-type => 'text/xml', -status => '404 Not Found');
73         return;
74     }
75
76     my $result = {};
77     my $inxml = $query->param('POSTDATA');
78     print $query->header(-type => 'text/xml');
79
80     my $record = eval {MARC::Record::new_from_xml( $inxml, "utf8", C4::Context->preference('marcflavour'))};
81     my $do_not_escape = 0;
82     if ($@) {
83         $result->{'status'} = "failed";
84         $result->{'error'} = $@;
85     } else {
86         # delete any item tags
87         my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber", '');
88         foreach my $field ($record->field($itemtag)) {
89             $record->delete_field($field);
90         }
91         ModBiblio($record, $biblionumber, '');
92         my $new_record = GetMarcBiblio($biblionumber);
93         $result->{'status'} = "ok";
94         $result->{'biblionumber'} = $biblionumber;
95         my $xml = $new_record->as_xml_record();
96         $xml =~ s/<\?xml.*?\?>//i;
97         $result->{'marcxml'} =  $xml;
98         $do_not_escape = 1;
99     }
100    
101     print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1, NoEscape => $do_not_escape); 
102 }