Bug 5897: Add new syspref ShowReviewer
[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
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 #
20
21 use strict;
22 use warnings;
23
24 use CGI;
25 use C4::Auth qw/check_api_auth/;
26 use C4::Biblio;
27 use XML::Simple;
28
29 my $query = new CGI;
30 binmode STDOUT, ":utf8";
31
32 my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 'edit_catalogue'} );
33 unless ($status eq "ok") {
34     print $query->header(-type => 'text/xml', -status => '403 Forbidden');
35     print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
36     exit 0;
37 }
38
39 # do initial validation
40 my $path_info = $query->path_info();
41
42 my $biblionumber = undef;
43 if ($path_info =~ m!^/(\d+)$!) {
44     $biblionumber = $1;
45 } else {
46     print $query->header(-type => 'text/xml', -status => '400 Bad Request');
47 }
48
49 # are we retrieving or updating a bib?
50 if ($query->request_method eq "GET") {
51     fetch_bib($query, $biblionumber);
52 } else {
53     update_bib($query, $biblionumber);
54 }
55
56 exit 0;
57
58 sub fetch_bib {
59     my $query = shift;
60     my $biblionumber = shift;
61     my $record = GetMarcBiblio($biblionumber);
62     if  (defined $record) {
63         print $query->header(-type => 'text/xml');
64         print $record->as_xml_record();
65     } else {
66         print $query->header(-type => 'text/xml', -status => '404 Not Found');
67     }
68 }
69
70 sub update_bib {
71     my $query = shift;
72     my $biblionumber = shift;
73     my $old_record = GetMarcBiblio($biblionumber);
74     unless  (defined $old_record) {
75         print $query->header(-type => 'text/xml', -status => '404 Not Found');
76         return;
77     }
78
79     my $result = {};
80     my $inxml = $query->param('POSTDATA');
81     print $query->header(-type => 'text/xml');
82
83     my $record = eval {MARC::Record::new_from_xml( $inxml, "utf8", C4::Context->preference('marcflavour'))};
84     my $do_not_escape = 0;
85     if ($@) {
86         $result->{'status'} = "failed";
87         $result->{'error'} = $@;
88     } else {
89         # delete any item tags
90         my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber", '');
91         foreach my $field ($record->field($itemtag)) {
92             $record->delete_field($field);
93         }
94         ModBiblio($record, $biblionumber, '');
95         my $new_record = GetMarcBiblio($biblionumber);
96         $result->{'status'} = "ok";
97         $result->{'biblionumber'} = $biblionumber;
98         my $xml = $new_record->as_xml_record();
99         $xml =~ s/<\?xml.*?\?>//i;
100         $result->{'marcxml'} =  $xml;
101         $do_not_escape = 1;
102     }
103    
104     print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1, NoEscape => $do_not_escape); 
105 }