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     GetMarcBiblio
  29     GetMarcControlnumber
  30 );
  31 use CGI qw ( -utf8 );
  32 use C4::Auth;
  33 use C4::Ris qw( marc2ris );
  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 $borcat = q{};
  47 if ($userenv) {
  48     my $borrowernumber = $userenv->{'number'};
  49     if ($borrowernumber) {
  50         my $borrower = Koha::Patrons->find( { borrowernumber => $borrowernumber } );
  51         $borcat = $borrower ? $borrower->categorycode : $borcat;
  52     }
  53 }
  54
  55 my $include_items = ($format =~ /bibtex/) ? 0 : 1;
  56 my $marc = $biblionumber
  57     ? GetMarcBiblio({
  58         biblionumber => $biblionumber,
  59         embed_items  => $include_items,
  60         opac         => 1,
  61         borcat       => $borcat })
  62     : undef;
  63
  64 if(!$marc) {
  65     print $query->redirect("/cgi-bin/koha/errors/404.pl");
  66     exit;
  67 }
  68
  69 my $file_id = $biblionumber;
  70 my $file_pre = "bib-";
  71 if( C4::Context->preference('DefaultSaveRecordFileID') eq 'controlnumber' ){
  72     my $marcflavour = C4::Context->preference('marcflavour'); #FIXME This option is required but does not change control num behaviour
  73     my $control_num = GetMarcControlnumber( $marc, $marcflavour );
  74     if( $control_num ){
  75         $file_id = $control_num;
  76         $file_pre = "record-";
  77     }
  78 }
  79
  80 # ASSERT: There is a biblionumber, because GetMarcBiblio returned something.
  81 my $framework = GetFrameworkCode( $biblionumber );
  82 my $record_processor = Koha::RecordProcessor->new({
  83     filters => 'ViewPolicy',
  84     options => {
  85         interface => 'opac',
  86         frameworkcode => $framework
  87     }
  88 });
  89 $record_processor->process($marc);
  90
  91 if ($format =~ /endnote/) {
  92     $marc = marc2endnote($marc);
  93     $format = 'endnote';
  94 }
  95 elsif ($format =~ /marcxml/) {
  96     $marc = marc2marcxml($marc);
  97     $format = 'marcxml';
  98 }
  99 elsif ($format=~ /mods/) {
 100     $marc = marc2modsxml($marc);
 101     $format = 'mods';
 102 }
 103 elsif ($format =~ /ris/) {
 104     $marc = marc2ris($marc);
 105     $format = 'ris';
 106 }
 107 elsif ($format =~ /bibtex/) {
 108     $marc = marc2bibtex($marc,$biblionumber);
 109     $format = 'bibtex';
 110 }
 111 elsif ($format =~ /^(dc|oaidc|srwdc|rdfdc)$/i ) {
 112     # TODO: Dublin Core leaks fields marked hidden by framework.
 113     $marc = marc2dcxml($marc, undef, $biblionumber, $format);
 114     $format = "dublin-core.xml";
 115 }
 116 elsif ($format =~ /marc8/) {
 117     ($error,$marc) = changeEncoding($marc,"MARC","MARC21","MARC-8");
 118     $marc = $marc->as_usmarc() unless $error;
 119     $format = 'marc8';
 120 }
 121 elsif ($format =~ /utf8/) {
 122     C4::Charset::SetUTF8Flag($marc,1);
 123     $marc = $marc->as_usmarc();
 124     $format = 'utf8';
 125 }
 126 elsif ($format =~ /marcstd/) {
 127     C4::Charset::SetUTF8Flag($marc,1);
 128     ($error,$marc) = marc2marc($marc, 'marcstd', C4::Context->preference('marcflavour'));
 129     $format = 'marcstd';
 130 }
 131 elsif ( $format =~ /isbd/ ) {
 132     $marc   = GetISBDView({
 133         'record'    => $marc,
 134         'template'  => 'opac',
 135         'framework' => $framework,
 136     });
 137     $format = 'isbd';
 138 }
 139 else {
 140     $error= "Format $format is not supported.";
 141 }
 142
 143 if ($error){
 144     print $query->header();
 145     print $query->start_html();
 146     print "<h1>An error occurred </h1>";
 147     print $query->escapeHTML("$error");
 148     print $query->end_html();
 149 }
 150 else {
 151     if ($format eq 'marc8'){
 152         print $query->header(
 153             -type => 'application/marc',
 154             -charset=>'ISO-2022',
 155             -attachment=>"$file_pre$file_id.$format");
 156     }
 157     elsif ( $format eq 'isbd' ) {
 158         print $query->header(
 159             -type       => 'text/plain',
 160             -charset    => 'utf-8',
 161             -attachment =>  "$file_pre$file_id.txt"
 162         );
 163     }
 164     elsif ( $format eq 'ris' ) {
 165         print $query->header(
 166             -type => 'text/plain',
 167             -charset => 'utf-8',
 168             -attachment => "$file_pre$file_id.$format"
 169         );
 170     } else {
 171         binmode STDOUT, ':encoding(UTF-8)';
 172         print $query->header(
 173             -type => 'application/octet-stream',
 174             -charset => 'utf-8',
 175             -attachment => "$file_pre$file_id.$format"
 176         );
 177     }
 178     print $marc;
 179 }
 180
 181 1;