Koha/Exporter/Record.pm

   1 package Koha::Exporter::Record;
   2
   3 use Modern::Perl;
   4 use MARC::File::XML;
   5 use MARC::File::USMARC;
   6
   7 use C4::AuthoritiesMarc;
   8 use C4::Biblio qw( GetMarcFromKohaField );
   9 use C4::Record;
  10 use Koha::Biblios;
  11 use Koha::CsvProfiles;
  12 use Koha::Logger;
  13 use List::Util qw( all any );
  14
  15 sub _get_record_for_export {
  16     my ($params)           = @_;
  17     my $record_type        = $params->{record_type};
  18     my $record_id          = $params->{record_id};
  19     my $conditions         = $params->{record_conditions};
  20     my $dont_export_fields = $params->{dont_export_fields};
  21     my $clean              = $params->{clean};
  22
  23     my $record;
  24     if ( $record_type eq 'auths' ) {
  25         $record = _get_authority_for_export( { %$params, authid => $record_id } );
  26     } elsif ( $record_type eq 'bibs' ) {
  27         $record = _get_biblio_for_export( { %$params, biblionumber => $record_id } );
  28     } else {
  29         Koha::Logger->get->warn( "Record_type $record_type not supported." );
  30     }
  31     if ( !$record ) {
  32         Koha::Logger->get->warn( "Record $record_id could not be exported." );
  33         return;
  34     }
  35
  36     # If multiple conditions all are required to match (and)
  37     # For matching against multiple marc targets all are also required to match
  38     my %operators = (
  39         '=' => sub {
  40             return $_[0] eq $_[1];
  41         },
  42         '!=' => sub {
  43             return $_[0] ne $_[1];
  44         },
  45         '>' => sub {
  46             return $_[0] gt $_[1];
  47         },
  48         '<' => sub {
  49             return $_[0] lt $_[1];
  50         },
  51     );
  52     if ($conditions) {
  53         foreach my $condition (@{$conditions}) {
  54             my ($field_tag, $subfield, $operator, $match_value) = @{$condition};
  55             my @fields = $record->field($field_tag);
  56             my $no_target = 0;
  57
  58             if (!@fields) {
  59                 $no_target = 1;
  60             }
  61             else {
  62                 if ($operator eq '?') {
  63                     return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
  64                 } elsif ($operator eq '!?') {
  65                     return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
  66                 } else {
  67                     my $op;
  68                     if (exists $operators{$operator}) {
  69                         $op = $operators{$operator};
  70                     } else {
  71                         die("Invalid operator: $op");
  72                     }
  73                     my @target_values = map { $subfield ? $_->subfield($subfield) : ($_->data()) } @fields;
  74                     if (!@target_values) {
  75                         $no_target = 1;
  76                     }
  77                     else {
  78                         return unless all { $op->($_, $match_value) } @target_values;
  79                     }
  80                 }
  81             }
  82             return if $no_target && $operator ne '!=';
  83         }
  84     }
  85
  86     if ($dont_export_fields) {
  87         for my $f ( split / /, $dont_export_fields ) {
  88             if ( $f =~ m/^(\d{3})(.)?$/ ) {
  89                 my ( $field, $subfield ) = ( $1, $2 );
  90
  91                 # skip if this record doesn't have this field
  92                 if ( defined $record->field($field) ) {
  93                     if ( defined $subfield ) {
  94                         my @tags = $record->field($field);
  95                         foreach my $t (@tags) {
  96                             $t->delete_subfields($subfield);
  97                         }
  98                     } else {
  99                         $record->delete_fields( $record->field($field) );
 100                     }
 101                 }
 102             }
 103         }
 104     }
 105     C4::Biblio::RemoveAllNsb($record) if $clean;
 106     return $record;
 107 }
 108
 109 sub _get_authority_for_export {
 110     my ($params) = @_;
 111     my $authid = $params->{authid} || return;
 112     my $authority = Koha::MetadataRecord::Authority->get_from_authid($authid);
 113     return unless $authority;
 114     return $authority->record;
 115 }
 116
 117 sub _get_biblio_for_export {
 118     my ($params)     = @_;
 119     my $biblionumber = $params->{biblionumber};
 120     my $itemnumbers  = $params->{itemnumbers};
 121     my $export_items = $params->{export_items} // 1;
 122     my $only_export_items_for_branches = $params->{only_export_items_for_branches};
 123
 124     my $biblio = Koha::Biblios->find($biblionumber);
 125     my $record = eval { $biblio->metadata->record };
 126
 127     return if $@ or not defined $record;
 128
 129     if ($export_items) {
 130         Koha::Biblio::Metadata->record(
 131             {
 132                 record       => $record,
 133                 embed_items  => 1,
 134                 biblionumber => $biblionumber,
 135                 itemnumbers => $itemnumbers,
 136             }
 137         );
 138         if ($only_export_items_for_branches && @$only_export_items_for_branches) {
 139             my %export_items_for_branches = map { $_ => 1 } @$only_export_items_for_branches;
 140             my ( $homebranchfield, $homebranchsubfield ) = GetMarcFromKohaField( 'items.homebranch' );
 141
 142             for my $itemfield ( $record->field($homebranchfield) ) {
 143                 my $homebranch = $itemfield->subfield($homebranchsubfield);
 144                 unless ( $export_items_for_branches{$homebranch} ) {
 145                     $record->delete_field($itemfield);
 146                 }
 147             }
 148         }
 149     }
 150     return $record;
 151 }
 152
 153 sub export {
 154     my ($params) = @_;
 155
 156     my $record_type        = $params->{record_type};
 157     my $record_ids         = $params->{record_ids} || [];
 158     my $format             = $params->{format};
 159     my $itemnumbers        = $params->{itemnumbers} || [];    # Does not make sense with record_type eq auths
 160     my $export_items       = $params->{export_items};
 161     my $dont_export_fields = $params->{dont_export_fields};
 162     my $csv_profile_id     = $params->{csv_profile_id};
 163     my $output_filepath    = $params->{output_filepath};
 164
 165     if( !$record_type ) {
 166         Koha::Logger->get->warn( "No record_type given." );
 167         return;
 168     }
 169     return unless @$record_ids;
 170
 171     my $fh;
 172     if ( $output_filepath ) {
 173         open $fh, '>', $output_filepath or die "Cannot open file $output_filepath ($!)";
 174         select $fh;
 175         binmode $fh, ':encoding(UTF-8)' unless $format eq 'csv';
 176     } else {
 177         binmode STDOUT, ':encoding(UTF-8)' unless $format eq 'csv';
 178     }
 179
 180     if ( $format eq 'iso2709' ) {
 181         for my $record_id (@$record_ids) {
 182             my $record = _get_record_for_export( { %$params, record_id => $record_id } );
 183             next unless $record;
 184             my $errorcount_on_decode = eval { scalar( MARC::File::USMARC->decode( $record->as_usmarc )->warnings() ) };
 185             if ( $errorcount_on_decode or $@ ) {
 186                 my $msg = "Record $record_id could not be exported. " .
 187                     ( $@ // '' );
 188                 chomp $msg;
 189                 Koha::Logger->get->info( $msg );
 190                 next;
 191             }
 192             print $record->as_usmarc();
 193         }
 194     } elsif ( $format eq 'xml' ) {
 195         my $marcflavour = C4::Context->preference("marcflavour");
 196         MARC::File::XML->default_record_format( ( $marcflavour eq 'UNIMARC' && $record_type eq 'auths' ) ? 'UNIMARCAUTH' : $marcflavour );
 197
 198         print MARC::File::XML::header();
 199         print "\n";
 200         for my $record_id (@$record_ids) {
 201             my $record = _get_record_for_export( { %$params, record_id => $record_id } );
 202             next unless $record;
 203             print MARC::File::XML::record($record);
 204             print "\n";
 205         }
 206         print MARC::File::XML::footer();
 207         print "\n";
 208     } elsif ( $format eq 'csv' ) {
 209         die 'There is no valid csv profile defined for this export'
 210             unless Koha::CsvProfiles->find( $csv_profile_id );
 211         print marc2csv( $record_ids, $csv_profile_id, $itemnumbers );
 212     }
 213
 214     close $fh if $output_filepath;
 215 }
 216
 217 1;
 218
 219 __END__
 220
 221 =head1 NAME
 222
 223 Koha::Exporter::Records - module to export records (biblios and authorities)
 224
 225 =head1 SYNOPSIS
 226
 227 This module provides a public subroutine to export records as xml, csv or iso2709.
 228
 229 =head2 FUNCTIONS
 230
 231 =head3 export
 232
 233     Koha::Exporter::Record::export($params);
 234
 235 $params is a hashref with some keys:
 236
 237 It will displays on STDOUT the generated file.
 238
 239 =over 4
 240
 241 =item record_type
 242
 243   Must be set to 'bibs' or 'auths'
 244
 245 =item record_ids
 246
 247   The list of the records to export (a list of biblionumber or authid)
 248
 249 =item format
 250
 251   The format must be 'csv', 'xml' or 'iso2709'.
 252
 253 =item itemnumbers
 254
 255   Generate the item infos only for these itemnumbers.
 256
 257   Must only be used with biblios.
 258
 259 =item export_items
 260
 261   If this flag is set, the items will be exported.
 262   Default is ON.
 263
 264 =item dont_export_fields
 265
 266   List of fields not to export.
 267
 268 =item csv_profile_id
 269
 270   If the format is csv, you have to define a csv_profile_id.
 271
 272 =cut
 273
 274 =back
 275
 276 =head1 LICENSE
 277
 278 This file is part of Koha.
 279
 280 Copyright Koha Development Team
 281
 282 Koha is free software; you can redistribute it and/or modify it
 283 under the terms of the GNU General Public License as published by
 284 the Free Software Foundation; either version 3 of the License, or
 285 (at your option) any later version.
 286
 287 Koha is distributed in the hope that it will be useful, but
 288 WITHOUT ANY WARRANTY; without even the implied warranty of
 289 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 290 GNU General Public License for more details.
 291
 292 You should have received a copy of the GNU General Public License
 293 along with Koha; if not, see <http://www.gnu.org/licenses>.