Bug 12311: Do not return a lost item if modified in a batch
[koha.git] / tools / export.pl
1 #!/usr/bin/perl
2
3 #
4 # This file is part of Koha.
5 #
6 # Koha is free software; you can redistribute it and/or modify it
7 # under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 3 of the License, or
9 # (at your option) any later version.
10 #
11 # Koha is distributed in the hope that it will be useful, but
12 # WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with Koha; if not, see <http://www.gnu.org/licenses>.
18
19 use Modern::Perl;
20 use MARC::File::XML;
21 use List::MoreUtils qw(uniq);
22 use Getopt::Long;
23 use CGI qw ( -utf8 );
24 use C4::Auth;
25 use C4::AuthoritiesMarc;    # GetAuthority
26 use C4::Biblio;             # GetMarcBiblio
27 use C4::Branch;             # GetBranches
28 use C4::Csv;
29 use C4::Koha;               # GetItemTypes
30 use C4::Output;
31 use C4::Record;
32
33 my $query = new CGI;
34
35 my $clean;
36 my $dont_export_items;
37 my $deleted_barcodes;
38 my $timestamp;
39 my $record_type;
40 my $id_list_file;
41 my $help;
42 my $op       = $query->param("op")       || '';
43 my $filename = $query->param("filename") || 'koha.mrc';
44 my $dbh      = C4::Context->dbh;
45 my $marcflavour = C4::Context->preference("marcflavour");
46 my $output_format = $query->param("format") || $query->param("output_format") || 'iso2709';
47
48 # Checks if the script is called from commandline
49 my $commandline = not defined $ENV{GATEWAY_INTERFACE};
50
51
52 # @biblionumbers is only use for csv export from circulation.pl
53 my @biblionumbers = uniq $query->param("biblionumbers");
54
55 if ( $commandline ) {
56
57     # Getting parameters
58     $op = 'export';
59     GetOptions(
60         'format=s'          => \$output_format,
61         'date=s'            => \$timestamp,
62         'dont_export_items' => \$dont_export_items,
63         'deleted_barcodes'  => \$deleted_barcodes,
64         'clean'             => \$clean,
65         'filename=s'        => \$filename,
66         'record-type=s'     => \$record_type,
67         'id_list_file=s'    => \$id_list_file,
68         'help|?'            => \$help
69     );
70
71     if ($help) {
72         print <<_USAGE_;
73 export.pl [--format=format] [--date=date] [--record-type=TYPE] [--dont_export_items] [--deleted_barcodes] [--clean] [--id_list_file=PATH] --filename=outputfile
74
75
76  --format=FORMAT        FORMAT is either 'xml' or 'marc' (default)
77
78  --date=DATE            DATE should be entered as the 'dateformat' syspref is
79                         set (dd/mm/yyyy for metric, yyyy-mm-dd for iso,
80                         mm/dd/yyyy for us) records exported are the ones that
81                         have been modified since DATE
82
83  --record-type=TYPE     TYPE is 'bibs' or 'auths'
84
85  --deleted_barcodes     If used, a list of barcodes of items deleted since DATE
86                         is produced (or from all deleted items if no date is
87                         specified). Used only if TYPE is 'bibs'
88
89  --clean                removes NSE/NSB
90
91  --id_list_file=PATH    PATH is a path to a file containing a list of
92                         IDs (biblionumber or authid) with one ID per line.
93                         This list works as a filter; it is compatible with
94                         other parameters for selecting records
95 _USAGE_
96         exit;
97     }
98
99     # Default parameters values :
100     $timestamp         ||= '';
101     $dont_export_items ||= 0;
102     $deleted_barcodes  ||= 0;
103     $clean             ||= 0;
104     $record_type       ||= "bibs";
105     $id_list_file       ||= 0;
106
107     # Redirect stdout
108     open STDOUT, '>', $filename if $filename;
109
110 }
111 else {
112
113     $op       = $query->param("op")       || '';
114     $filename = $query->param("filename") || 'koha.mrc';
115     $filename =~ s/(\r|\n)//;
116
117 }
118
119 # Default value for output_format is 'iso2709'
120 $output_format ||= 'iso2709';
121 # Retrocompatibility for the format parameter
122 $output_format = 'iso2709' if $output_format eq 'marc';
123
124 my ( $template, $loggedinuser, $cookie, $flags ) = get_template_and_user(
125     {
126         template_name   => "tools/export.tt",
127         query           => $query,
128         type            => "intranet",
129         authnotrequired => $commandline,
130         flagsrequired   => { tools => 'export_catalog' },
131         debug           => 1,
132     }
133 );
134
135 my $limit_ind_branch =
136   (      C4::Context->preference('IndependentBranches')
137       && C4::Context->userenv
138       && !C4::Context->IsSuperLibrarian()
139       && C4::Context->userenv->{branch} ) ? 1 : 0;
140
141 my @branch = $query->param("branch");
142 if (   C4::Context->preference("IndependentBranches")
143     && C4::Context->userenv
144     && !C4::Context->IsSuperLibrarian() )
145 {
146     @branch = ( C4::Context->userenv->{'branch'} );
147 }
148 # if stripping nonlocal items, use loggedinuser's branch
149 my $localbranch = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
150
151 my %branchmap = map { $_ => 1 } @branch; # for quick lookups
152
153 my $backupdir = C4::Context->config('backupdir');
154
155 if ( $op eq "export" ) {
156     if (
157         $output_format eq "iso2709"
158             or $output_format eq "xml"
159             or (
160                 $output_format eq 'csv'
161                     and not @biblionumbers
162             )
163     ) {
164         my $charset  = 'utf-8';
165         my $mimetype = 'application/octet-stream';
166
167         binmode STDOUT, ':encoding(UTF-8)'
168             if $filename =~ m/\.gz$/
169                or $filename =~ m/\.bz2$/
170                or $output_format ne 'csv';
171
172         if ( $filename =~ m/\.gz$/ ) {
173             $mimetype = 'application/x-gzip';
174             $charset  = '';
175             binmode STDOUT;
176         }
177         elsif ( $filename =~ m/\.bz2$/ ) {
178             $mimetype = 'application/x-bzip2';
179             binmode STDOUT;
180             $charset = '';
181         }
182         print $query->header(
183             -type       => $mimetype,
184             -charset    => $charset,
185             -attachment => $filename,
186         ) unless ($commandline);
187
188         $record_type = $query->param("record_type") unless ($commandline);
189         my $export_remove_fields = $query->param("export_remove_fields");
190         my @biblionumbers      = $query->param("biblionumbers");
191         my @itemnumbers        = $query->param("itemnumbers");
192         my @sql_params;
193         my $sql_query;
194         my @recordids;
195
196         my $StartingBiblionumber = $query->param("StartingBiblionumber");
197         my $EndingBiblionumber   = $query->param("EndingBiblionumber");
198         my $itemtype             = $query->param("itemtype");
199         my $start_callnumber     = $query->param("start_callnumber");
200         my $end_callnumber       = $query->param("end_callnumber");
201         $timestamp = ($timestamp) ? C4::Dates->new($timestamp) : ''
202           if ($commandline);
203         my $start_accession =
204           ( $query->param("start_accession") )
205           ? C4::Dates->new( $query->param("start_accession") )
206           : '';
207         my $end_accession =
208           ( $query->param("end_accession") )
209           ? C4::Dates->new( $query->param("end_accession") )
210           : '';
211         $dont_export_items = $query->param("dont_export_item")
212           unless ($commandline);
213
214         my $strip_nonlocal_items = $query->param("strip_nonlocal_items");
215
216         my $biblioitemstable =
217           ( $commandline and $deleted_barcodes )
218           ? 'deletedbiblioitems'
219           : 'biblioitems';
220         my $itemstable =
221           ( $commandline and $deleted_barcodes )
222           ? 'deleteditems'
223           : 'items';
224
225         my $starting_authid = $query->param('starting_authid');
226         my $ending_authid   = $query->param('ending_authid');
227         my $authtype        = $query->param('authtype');
228         my $filefh;
229         if ($commandline) {
230             open $filefh,"<", $id_list_file or die "cannot open $id_list_file: $!" if $id_list_file;
231         } else {
232             $filefh = $query->upload("id_list_file");
233         }
234         my %id_filter;
235         if ($filefh) {
236             while (my $number=<$filefh>){
237                 $number=~s/[\r\n]*$//;
238                 $id_filter{$number}=1 if $number=~/^\d+$/;
239             }
240         }
241
242         if ( $record_type eq 'bibs' and not @biblionumbers ) {
243             if ($timestamp) {
244
245             # Specific query when timestamp is used
246             # Actually it's used only with CLI and so all previous filters
247             # are not used.
248             # If one day timestamp is used via the web interface, this part will
249             # certainly have to be rewrited
250                 my ( $query, $params ) = construct_query(
251                     {
252                         recordtype       => $record_type,
253                         timestamp        => $timestamp,
254                         biblioitemstable => $biblioitemstable,
255                     }
256                 );
257                 $sql_query  = $query;
258                 @sql_params = @$params;
259
260             }
261             else {
262                 my ( $query, $params ) = construct_query(
263                     {
264                         recordtype           => $record_type,
265                         biblioitemstable     => $biblioitemstable,
266                         itemstable           => $itemstable,
267                         StartingBiblionumber => $StartingBiblionumber,
268                         EndingBiblionumber   => $EndingBiblionumber,
269                         branch               => \@branch,
270                         start_callnumber     => $start_callnumber,
271                         end_callnumber       => $end_callnumber,
272                         start_accession      => $start_accession,
273                         end_accession        => $end_accession,
274                         itemtype             => $itemtype,
275                     }
276                 );
277                 $sql_query  = $query;
278                 @sql_params = @$params;
279             }
280         }
281         elsif ( $record_type eq 'auths' ) {
282             my ( $query, $params ) = construct_query(
283                 {
284                     recordtype      => $record_type,
285                     starting_authid => $starting_authid,
286                     ending_authid   => $ending_authid,
287                     authtype        => $authtype,
288                 }
289             );
290             $sql_query  = $query;
291             @sql_params = @$params;
292
293         }
294         elsif ( $record_type eq 'db' ) {
295             my $successful_export;
296             if ( $flags->{superlibrarian}
297                 && C4::Context->config('backup_db_via_tools') )
298             {
299                 $successful_export = download_backup(
300                     {
301                         directory => "$backupdir",
302                         extension => 'sql',
303                         filename  => "$filename"
304                     }
305                 );
306             }
307             unless ($successful_export) {
308                 my $remotehost = $query->remote_host();
309                 $remotehost =~ s/(\n|\r)//;
310                 warn
311 "A suspicious attempt was made to download the db at '$filename' by someone at "
312                   . $remotehost . "\n";
313             }
314             exit;
315         }
316         elsif ( $record_type eq 'conf' ) {
317             my $successful_export;
318             if ( $flags->{superlibrarian}
319                 && C4::Context->config('backup_conf_via_tools') )
320             {
321                 $successful_export = download_backup(
322                     {
323                         directory => "$backupdir",
324                         extension => 'tar',
325                         filename  => "$filename"
326                     }
327                 );
328             }
329             unless ($successful_export) {
330                 my $remotehost = $query->remote_host();
331                 $remotehost =~ s/(\n|\r)//;
332                 warn
333 "A suspicious attempt was made to download the configuration at '$filename' by someone at "
334                   . $remotehost . "\n";
335             }
336             exit;
337         }
338         elsif (@biblionumbers) {
339             push @recordids, (@biblionumbers);
340         }
341         else {
342
343             # Someone is trying to mess us up
344             exit;
345         }
346         unless (@biblionumbers) {
347             my $sth = $dbh->prepare($sql_query);
348             $sth->execute(@sql_params);
349             push @recordids, map {
350                 map { $$_[0] } $_
351             } @{ $sth->fetchall_arrayref };
352             @recordids = grep { exists($id_filter{$_}) } @recordids if scalar(%id_filter);
353         }
354
355         my $xml_header_written = 0;
356         for my $recordid ( uniq @recordids ) {
357             if ($deleted_barcodes) {
358                 my $q = "
359                     SELECT DISTINCT barcode
360                     FROM deleteditems
361                     WHERE deleteditems.biblionumber = ?
362                 ";
363                 my $sth = $dbh->prepare($q);
364                 $sth->execute($recordid);
365                 while ( my $row = $sth->fetchrow_array ) {
366                     print "$row\n";
367                 }
368             }
369             else {
370                 my $record;
371                 if ( $record_type eq 'bibs' ) {
372                     $record = eval { GetMarcBiblio($recordid); };
373
374                     next if $@;
375                     next if not defined $record;
376                     C4::Biblio::EmbedItemsInMarcBiblio( $record, $recordid,
377                         \@itemnumbers )
378                       unless $dont_export_items;
379                     if (   $strip_nonlocal_items
380                         || $limit_ind_branch
381                         || $dont_export_items )
382                     {
383                         my ( $homebranchfield, $homebranchsubfield ) =
384                           GetMarcFromKohaField( 'items.homebranch', '' );
385                         for my $itemfield ( $record->field($homebranchfield) ) {
386                             $record->delete_field($itemfield)
387                               if ( $dont_export_items
388                                 || $localbranch ne $itemfield->subfield(
389                                         $homebranchsubfield) );
390                         }
391                     }
392                 }
393                 elsif ( $record_type eq 'auths' ) {
394                     $record = C4::AuthoritiesMarc::GetAuthority($recordid);
395                     next if not defined $record;
396                 }
397
398                 if ($export_remove_fields) {
399                     for my $f ( split / /, $export_remove_fields ) {
400                         if ( $f =~ m/^(\d{3})(.)?$/ ) {
401                             my ( $field, $subfield ) = ( $1, $2 );
402
403                             # skip if this record doesn't have this field
404                             if ( defined $record->field($field) ) {
405                                 if ( defined $subfield ) {
406                                     my @tags = $record->field($field);
407                                     foreach my $t (@tags) {
408                                         $t->delete_subfields($subfield);
409                                     }
410                                 }
411                                 else {
412                                     $record->delete_fields($record->field($field));
413                                 }
414                             }
415                         }
416                     }
417                 }
418                 RemoveAllNsb($record) if ($clean);
419                 if ( $output_format eq "xml" ) {
420                     unless ($xml_header_written) {
421                         MARC::File::XML->default_record_format(
422                             (
423                                      $marcflavour eq 'UNIMARC'
424                                   && $record_type eq 'auths'
425                             ) ? 'UNIMARCAUTH' : $marcflavour
426                         );
427                         print MARC::File::XML::header();
428                         print "\n";
429                         $xml_header_written = 1;
430                     }
431                     print MARC::File::XML::record($record);
432                     print "\n";
433                 }
434                 elsif ( $output_format eq 'iso2709' ) {
435                     my $errorcount_on_decode = eval { scalar(MARC::File::USMARC->decode( $record->as_usmarc )->warnings()) };
436                     if ($errorcount_on_decode or $@){
437                         warn $@ if $@;
438                         warn "record (number $recordid) is invalid and therefore not exported because its reopening generates warnings above";
439                         next;
440                     }
441                     print $record->as_usmarc();
442                 }
443             }
444         }
445         if ($xml_header_written) {
446             print MARC::File::XML::footer();
447             print "\n";
448         }
449         if ( $output_format eq 'csv' ) {
450             my $csv_profile_id = $query->param('csv_profile')
451                 || GetCsvProfileId( C4::Context->preference('ExportWithCsvProfile') );
452             my $output =
453               marc2csv( \@recordids,
454                 $csv_profile_id );
455
456             print $output;
457         }
458
459         exit;
460     }
461     elsif ( $output_format eq "csv" ) {
462         my @biblionumbers = uniq $query->param("biblionumbers");
463         my @itemnumbers   = $query->param("itemnumbers");
464         my $csv_profile_id = $query->param('csv_profile') || GetCsvProfileId( C4::Context->preference('ExportWithCsvProfile') );
465         my $output =
466           marc2csv( \@biblionumbers,
467             $csv_profile_id,
468             \@itemnumbers, );
469         print $query->header(
470             -type                        => 'application/octet-stream',
471             -'Content-Transfer-Encoding' => 'binary',
472             -attachment                  => "export.csv"
473         );
474         print $output;
475         exit;
476     }
477 }    # if export
478
479 else {
480
481     my $itemtypes = GetItemTypes;
482     my @itemtypesloop;
483     foreach my $thisitemtype ( sort keys %$itemtypes ) {
484         my %row = (
485             value       => $thisitemtype,
486             description => $itemtypes->{$thisitemtype}->{'description'},
487         );
488         push @itemtypesloop, \%row;
489     }
490     my $branches = GetBranches($limit_ind_branch);
491     my @branchloop;
492     for my $thisbranch (
493         sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} }
494         keys %{$branches}
495       )
496     {
497         push @branchloop,
498           {
499             value      => $thisbranch,
500             selected   => %branchmap ? $branchmap{$thisbranch} : 1,
501             branchname => $branches->{$thisbranch}->{'branchname'},
502           };
503     }
504
505     my $authtypes = getauthtypes;
506     my @authtypesloop;
507     foreach my $thisauthtype ( sort keys %$authtypes ) {
508         next unless $thisauthtype;
509         my %row = (
510             value       => $thisauthtype,
511             description => $authtypes->{$thisauthtype}->{'authtypetext'},
512         );
513         push @authtypesloop, \%row;
514     }
515
516     if (   $flags->{superlibrarian}
517         && C4::Context->config('backup_db_via_tools')
518         && $backupdir
519         && -d $backupdir )
520     {
521         $template->{VARS}->{'allow_db_export'} = 1;
522         $template->{VARS}->{'dbfiles'}         = getbackupfilelist(
523             { directory => "$backupdir", extension => 'sql' } );
524     }
525
526     if (   $flags->{superlibrarian}
527         && C4::Context->config('backup_conf_via_tools')
528         && $backupdir
529         && -d $backupdir )
530     {
531         $template->{VARS}->{'allow_conf_export'} = 1;
532         $template->{VARS}->{'conffiles'}         = getbackupfilelist(
533             { directory => "$backupdir", extension => 'tar' } );
534     }
535
536     $template->param(
537         branchloop               => \@branchloop,
538         itemtypeloop             => \@itemtypesloop,
539         authtypeloop             => \@authtypesloop,
540         export_remove_fields     => C4::Context->preference("ExportRemoveFields"),
541         csv_profiles             => C4::Csv::GetCsvProfiles('marc'),
542     );
543
544     output_html_with_http_headers $query, $cookie, $template->output;
545 }
546
547 sub construct_query {
548     my ($params) = @_;
549
550     my ( $sql_query, @sql_params );
551
552     if ( $params->{recordtype} eq "bibs" ) {
553         if ( $params->{timestamp} ) {
554             my $biblioitemstable = $params->{biblioitemstable};
555             $sql_query = " (
556                 SELECT biblionumber
557                 FROM $biblioitemstable
558                   LEFT JOIN items USING(biblionumber)
559                 WHERE $biblioitemstable.timestamp >= ?
560                   OR items.timestamp >= ?
561             ) UNION (
562                 SELECT biblionumber
563                 FROM $biblioitemstable
564                   LEFT JOIN deleteditems USING(biblionumber)
565                 WHERE $biblioitemstable.timestamp >= ?
566                   OR deleteditems.timestamp >= ?
567             ) ";
568             my $ts = $timestamp->output('iso');
569             @sql_params = ( $ts, $ts, $ts, $ts );
570         }
571         else {
572             my $biblioitemstable     = $params->{biblioitemstable};
573             my $itemstable           = $params->{itemstable};
574             my $StartingBiblionumber = $params->{StartingBiblionumber};
575             my $EndingBiblionumber   = $params->{EndingBiblionumber};
576             my @branch               = @{ $params->{branch} };
577             my $start_callnumber     = $params->{start_callnumber};
578             my $end_callnumber       = $params->{end_callnumber};
579             my $start_accession      = $params->{start_accession};
580             my $end_accession        = $params->{end_accession};
581             my $itemtype             = $params->{itemtype};
582             my $items_filter =
583                  @branch
584               || $start_callnumber
585               || $end_callnumber
586               || $start_accession
587               || $end_accession
588               || ( $itemtype && C4::Context->preference('item-level_itypes') );
589             $sql_query = $items_filter
590               ? "SELECT DISTINCT $biblioitemstable.biblionumber
591                 FROM $biblioitemstable JOIN $itemstable
592                 USING (biblionumber) WHERE 1"
593               : "SELECT $biblioitemstable.biblionumber FROM $biblioitemstable WHERE biblionumber >0 ";
594
595             if ($StartingBiblionumber) {
596                 $sql_query .= " AND $biblioitemstable.biblionumber >= ? ";
597                 push @sql_params, $StartingBiblionumber;
598             }
599
600             if ($EndingBiblionumber) {
601                 $sql_query .= " AND $biblioitemstable.biblionumber <= ? ";
602                 push @sql_params, $EndingBiblionumber;
603             }
604
605             if (@branch) {
606                 $sql_query .= " AND homebranch IN (".join(',',map({'?'} @branch)).")";
607                 push @sql_params, @branch;
608             }
609
610             if ($start_callnumber) {
611                 $sql_query .= " AND itemcallnumber >= ? ";
612                 push @sql_params, $start_callnumber;
613             }
614
615             if ($end_callnumber) {
616                 $sql_query .= " AND itemcallnumber <= ? ";
617                 push @sql_params, $end_callnumber;
618             }
619             if ($start_accession) {
620                 $sql_query .= " AND dateaccessioned >= ? ";
621                 push @sql_params, $start_accession->output('iso');
622             }
623
624             if ($end_accession) {
625                 $sql_query .= " AND dateaccessioned <= ? ";
626                 push @sql_params, $end_accession->output('iso');
627             }
628
629             if ($itemtype) {
630                 $sql_query .=
631                   ( C4::Context->preference('item-level_itypes') )
632                   ? " AND items.itype = ? "
633                   : " AND biblioitems.itemtype = ?";
634                 push @sql_params, $itemtype;
635             }
636         }
637     }
638     elsif ( $params->{recordtype} eq "auths" ) {
639         if ( $params->{timestamp} ) {
640
641             #TODO
642         }
643         else {
644             my $starting_authid = $params->{starting_authid};
645             my $ending_authid   = $params->{ending_authid};
646             my $authtype        = $params->{authtype};
647             $sql_query =
648               "SELECT DISTINCT auth_header.authid FROM auth_header WHERE 1";
649
650             if ($starting_authid) {
651                 $sql_query .= " AND auth_header.authid >= ? ";
652                 push @sql_params, $starting_authid;
653             }
654
655             if ($ending_authid) {
656                 $sql_query .= " AND auth_header.authid <= ? ";
657                 push @sql_params, $ending_authid;
658             }
659
660             if ($authtype) {
661                 $sql_query .= " AND auth_header.authtypecode = ? ";
662                 push @sql_params, $authtype;
663             }
664         }
665     }
666     return ( $sql_query, \@sql_params );
667 }
668
669 sub getbackupfilelist {
670     my $args      = shift;
671     my $directory = $args->{directory};
672     my $extension = $args->{extension};
673     my @files;
674
675     if ( opendir( my $dir, $directory ) ) {
676         while ( my $file = readdir($dir) ) {
677             next unless ( $file =~ m/\.$extension(\.(gz|bz2|xz))?/ );
678             push @files, $file
679               if ( -f "$directory/$file" && -r "$directory/$file" );
680         }
681         closedir($dir);
682     }
683     return \@files;
684 }
685
686 sub download_backup {
687     my $args      = shift;
688     my $directory = $args->{directory};
689     my $extension = $args->{extension};
690     my $filename  = $args->{filename};
691
692     return unless ( $directory && -d $directory );
693     return unless ( $filename =~ m/\.$extension(\.(gz|bz2|xz))?$/ );
694     return if ( $filename =~ m#/# );
695     $filename = "$directory/$filename";
696     return unless ( -f $filename && -r $filename );
697     return unless ( open( my $dump, '<', $filename ) );
698     binmode $dump;
699
700     while ( read( $dump, my $data, 64 * 1024 ) ) {
701         print $data;
702     }
703     close($dump);
704     return 1;
705 }