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