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