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