opac/opac-export.pl

   1 #!/usr/bin/perl
   2
   3 # Parts Copyright Catalyst IT 2011
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use C4::Record;
  23 use C4::Auth;
  24 use C4::Output;
  25 use C4::Biblio qw(
  26     GetFrameworkCode
  27     GetISBDView
  28     GetMarcControlnumber
  29 );
  30 use CGI qw ( -utf8 );
  31 use C4::Auth;
  32 use C4::Ris qw( marc2ris );
  33 use Koha::Biblios;
  34 use Koha::RecordProcessor;
  35
  36 my $query = CGI->new;
  37 my $op=$query->param("op")||''; #op=export is currently the only use
  38 my $format=$query->param("format")||'utf8';
  39 my $biblionumber = $query->param("bib")||0;
  40 $biblionumber = int($biblionumber);
  41 my $error = q{};
  42
  43 # Determine logged in user's patron category.
  44 # Blank if not logged in.
  45 my $userenv = C4::Context->userenv;
  46 my $patron;
  47 if ($userenv) {
  48     my $borrowernumber = $userenv->{'number'};
  49     if ($borrowernumber) {
  50         $patron = Koha::Patrons->find( $borrowernumber );
  51     }
  52 }
  53
  54 my $include_items = ($format =~ /bibtex/) ? 0 : 1;
  55 my $biblio = Koha::Biblios->find($biblionumber);
  56 my $marc = $biblio
  57   ? $biblio->metadata->record(
  58     {
  59         embed_items => 1,
  60         opac        => 1,
  61         patron      => $patron,
  62     }
  63   )
  64   : undef;
  65
  66 if(!$marc) {
  67     print $query->redirect("/cgi-bin/koha/errors/404.pl");
  68     exit;
  69 }
  70
  71 my $file_id = $biblionumber;
  72 my $file_pre = "bib-";
  73 if( C4::Context->preference('DefaultSaveRecordFileID') eq 'controlnumber' ){
  74     my $marcflavour = C4::Context->preference('marcflavour'); #FIXME This option is required but does not change control num behaviour
  75     my $control_num = GetMarcControlnumber( $marc, $marcflavour );
  76     if( $control_num ){
  77         $file_id = $control_num;
  78         $file_pre = "record-";
  79     }
  80 }
  81
  82 my $framework = $biblio->frameworkcode;
  83 my $record_processor = Koha::RecordProcessor->new({
  84     filters => 'ViewPolicy',
  85     options => {
  86         interface => 'opac',
  87         frameworkcode => $framework
  88     }
  89 });
  90 $record_processor->process($marc);
  91
  92 if ($format =~ /endnote/) {
  93     $marc = marc2endnote($marc);
  94     $format = 'endnote';
  95 }
  96 elsif ($format =~ /marcxml/) {
  97     $marc = marc2marcxml($marc);
  98     $format = 'marcxml';
  99 }
 100 elsif ($format=~ /mods/) {
 101     $marc = marc2modsxml($marc);
 102     $format = 'mods';
 103 }
 104 elsif ($format =~ /ris/) {
 105     $marc = marc2ris($marc);
 106     $format = 'ris';
 107 }
 108 elsif ($format =~ /bibtex/) {
 109     $marc = marc2bibtex($marc,$biblionumber);
 110     $format = 'bibtex';
 111 }
 112 elsif ($format =~ /^(dc|oaidc|srwdc|rdfdc)$/i ) {
 113     # TODO: Dublin Core leaks fields marked hidden by framework.
 114     $marc = marc2dcxml($marc, undef, $biblionumber, $format);
 115     $format = "dublin-core.xml";
 116 }
 117 elsif ($format =~ /marc8/) {
 118     ($error,$marc) = changeEncoding($marc,"MARC","MARC21","MARC-8");
 119     $marc = $marc->as_usmarc() unless $error;
 120     $format = 'marc8';
 121 }
 122 elsif ($format =~ /utf8/) {
 123     C4::Charset::SetUTF8Flag($marc,1);
 124     $marc = $marc->as_usmarc();
 125     $format = 'utf8';
 126 }
 127 elsif ($format =~ /marcstd/) {
 128     C4::Charset::SetUTF8Flag($marc,1);
 129     ($error,$marc) = marc2marc($marc, 'marcstd', C4::Context->preference('marcflavour'));
 130     $format = 'marcstd';
 131 }
 132 elsif ( $format =~ /isbd/ ) {
 133     $marc   = GetISBDView({
 134         'record'    => $marc,
 135         'template'  => 'opac',
 136         'framework' => $framework,
 137     });
 138     $format = 'isbd';
 139 }
 140 else {
 141     $error= "Format $format is not supported.";
 142 }
 143
 144 if ($error){
 145     print $query->header();
 146     print $query->start_html();
 147     print "<h1>An error occurred </h1>";
 148     print $query->escapeHTML("$error");
 149     print $query->end_html();
 150 }
 151 else {
 152     if ($format eq 'marc8'){
 153         print $query->header(
 154             -type => 'application/marc',
 155             -charset=>'ISO-2022',
 156             -attachment=>"$file_pre$file_id.$format");
 157     }
 158     elsif ( $format eq 'isbd' ) {
 159         print $query->header(
 160             -type       => 'text/plain',
 161             -charset    => 'utf-8',
 162             -attachment =>  "$file_pre$file_id.txt"
 163         );
 164     }
 165     elsif ( $format eq 'ris' ) {
 166         print $query->header(
 167             -type => 'text/plain',
 168             -charset => 'utf-8',
 169             -attachment => "$file_pre$file_id.$format"
 170         );
 171     } else {
 172         binmode STDOUT, ':encoding(UTF-8)';
 173         print $query->header(
 174             -type => 'application/octet-stream',
 175             -charset => 'utf-8',
 176             -attachment => "$file_pre$file_id.$format"
 177         );
 178     }
 179     print $marc;
 180 }
 181
 182 1;