"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/svc/bib" (23 Feb 2021, 4861 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "bib": 20.05.06_vs_20.11.00.

    1 #!/usr/bin/perl
    2 
    3 # Copyright 2007 LibLime
    4 # Copyright 2012 software.coop and MJ Ray
    5 #
    6 # This file is part of Koha.
    7 #
    8 # Koha is free software; you can redistribute it and/or modify it
    9 # under the terms of the GNU General Public License as published by
   10 # the Free Software Foundation; either version 3 of the License, or
   11 # (at your option) any later version.
   12 #
   13 # Koha is distributed in the hope that it will be useful, but
   14 # WITHOUT ANY WARRANTY; without even the implied warranty of
   15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
   16 # GNU General Public License for more details.
   17 #
   18 # You should have received a copy of the GNU General Public License
   19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
   20 #
   21 
   22 use Modern::Perl;
   23 
   24 use CGI qw ( -utf8 );
   25 use C4::Auth qw/check_api_auth/;
   26 use C4::Biblio;
   27 use C4::Items;
   28 use XML::Simple;
   29 
   30 my $query = new CGI;
   31 binmode STDOUT, ':encoding(UTF-8)';
   32 
   33 my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 'edit_catalogue'} );
   34 unless ($status eq "ok") {
   35     print $query->header(-type => 'text/xml', -status => '403 Forbidden');
   36     print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
   37     exit 0;
   38 }
   39 
   40 # do initial validation
   41 my $path_info = $query->path_info();
   42 
   43 my $biblionumber = undef;
   44 if ($path_info =~ m!^/(\d+)$!) {
   45     $biblionumber = $1;
   46 } else {
   47     print $query->header(-type => 'text/xml', -status => '400 Bad Request');
   48 }
   49 
   50 # are we retrieving, updating or deleting a bib?
   51 if ($query->request_method eq "GET") {
   52     fetch_bib($query, $biblionumber);
   53 } elsif ($query->request_method eq "POST") {
   54     update_bib($query, $biblionumber);
   55 } elsif ($query->request_method eq "DELETE") {
   56     delete_bib($query, $biblionumber);
   57 } else {
   58     print $query->header(-type => 'text/xml', -status => '405 Method not allowed');
   59     print XMLout({ error => 'Method not allowed' }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
   60     exit 0;
   61 }
   62 
   63 exit 0;
   64 
   65 sub fetch_bib {
   66     my $query = shift;
   67     my $biblionumber = shift;
   68     my $record = GetMarcBiblio({
   69         biblionumber => $biblionumber,
   70         embed_items  => scalar $query->param('items') });
   71     if  (defined $record) {
   72         print $query->header(-type => 'text/xml',-charset => 'utf-8',);
   73         print $record->as_xml_record();
   74     } else {
   75         print $query->header(-type => 'text/xml', -status => '404 Not Found');
   76     }
   77 }
   78 
   79 sub update_bib {
   80     my $query = shift;
   81     my $biblionumber = shift;
   82     my $old_record = GetMarcBiblio({ biblionumber => $biblionumber });
   83     my $frameworkcode = $query->url_param('frameworkcode') // GetFrameworkCode($biblionumber);
   84     unless  (defined $old_record) {
   85         print $query->header(-type => 'text/xml', -status => '404 Not Found');
   86         return;
   87     }
   88 
   89     my $result = {};
   90     my $inxml = $query->param('POSTDATA');
   91     print $query->header(-type => 'text/xml', -charset => 'utf-8');
   92 
   93     my $record = eval {MARC::Record::new_from_xml( $inxml, "UTF-8", C4::Context->preference('marcflavour'))};
   94     my $do_not_escape = 0;
   95     if ($@) {
   96         $result->{'status'} = "failed";
   97         $result->{'error'} = $@;
   98     } else {
   99         my $fullrecord = $record->clone();
  100         my ( $itemtag, $itemsubfield ) =
  101           GetMarcFromKohaField( "items.itemnumber" );
  102 
  103         # delete any item tags
  104         foreach my $field ( $record->field($itemtag) ) {
  105             $record->delete_field($field);
  106         }
  107 
  108         if ( $query->url_param('items') ) {
  109             foreach my $field ( $fullrecord->field($itemtag) ) {
  110                 my $one_item_record = $record->clone();
  111                 $one_item_record->add_fields($field);
  112                 ModItemFromMarc( $one_item_record, $biblionumber,
  113                     $field->subfield($itemsubfield) );
  114             }
  115         }
  116 
  117         ModBiblio( $record, $biblionumber, $frameworkcode );
  118         my $new_record = GetMarcBiblio({
  119             biblionumber => $biblionumber,
  120             embed_items  => scalar $query->url_param('items') });
  121 
  122         $result->{'status'} = "ok";
  123         $result->{'biblionumber'} = $biblionumber;
  124         my $xml = $new_record->as_xml_record();
  125         $xml =~ s/<\?xml.*?\?>//i;
  126         $result->{'marcxml'} =  $xml;
  127         $do_not_escape = 1;
  128     }
  129    
  130     print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1, NoEscape => $do_not_escape); 
  131 }
  132 
  133 sub delete_bib {
  134     my $query = shift;
  135     my $biblionumber = shift;
  136     my $error = DelBiblio($biblionumber);
  137 
  138     if (defined $error) {
  139         print $query->header(-type => 'text/xml', -status => '400 Bad request');
  140         print XMLout({ error => $error }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
  141         exit 0;
  142     }
  143 
  144     print $query->header(-type => 'text/xml');
  145     print XMLout({ status => 'OK, biblio deleted' }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
  146 }