Bug 14356: Improvements to the 'Transfers to receive' page
[koha.git] / tools / export.pl
index 8a5c2a5..f63e2c4 100755 (executable)
@@ -3,24 +3,24 @@
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA  02111-1307 USA
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 use Modern::Perl;
 use MARC::File::XML;
 use List::MoreUtils qw(uniq);
 use Getopt::Long;
-use CGI;
+use CGI qw ( -utf8 );
 use C4::Auth;
 use C4::AuthoritiesMarc;    # GetAuthority
 use C4::Biblio;             # GetMarcBiblio
@@ -33,7 +33,6 @@ use C4::Record;
 my $query = new CGI;
 
 my $clean;
-my $output_format;
 my $dont_export_items;
 my $deleted_barcodes;
 my $timestamp;
@@ -44,11 +43,15 @@ my $op       = $query->param("op")       || '';
 my $filename = $query->param("filename") || 'koha.mrc';
 my $dbh      = C4::Context->dbh;
 my $marcflavour = C4::Context->preference("marcflavour");
-my $format = $query->param("format") || 'iso2709';
+my $output_format = $query->param("format") || $query->param("output_format") || 'iso2709';
 
 # Checks if the script is called from commandline
 my $commandline = not defined $ENV{GATEWAY_INTERFACE};
 
+
+# @biblionumbers is only use for csv export from circulation.pl
+my @biblionumbers = uniq $query->param("biblionumbers");
+
 if ( $commandline ) {
 
     # Getting parameters
@@ -94,7 +97,6 @@ _USAGE_
     }
 
     # Default parameters values :
-    $output_format     ||= 'marc';
     $timestamp         ||= '';
     $dont_export_items ||= 0;
     $deleted_barcodes  ||= 0;
@@ -114,6 +116,11 @@ else {
 
 }
 
+# Default value for output_format is 'iso2709'
+$output_format ||= 'iso2709';
+# Retrocompatibility for the format parameter
+$output_format = 'iso2709' if $output_format eq 'marc';
+
 my ( $template, $loggedinuser, $cookie, $flags ) = get_template_and_user(
     {
         template_name   => "tools/export.tt",
@@ -131,21 +138,36 @@ my $limit_ind_branch =
       && !C4::Context->IsSuperLibrarian()
       && C4::Context->userenv->{branch} ) ? 1 : 0;
 
-my $branch = $query->param("branch") || '';
+my @branch = $query->param("branch");
 if (   C4::Context->preference("IndependentBranches")
     && C4::Context->userenv
     && !C4::Context->IsSuperLibrarian() )
 {
-    $branch = C4::Context->userenv->{'branch'};
+    @branch = ( C4::Context->userenv->{'branch'} );
 }
+# if stripping nonlocal items, use loggedinuser's branch
+my $localbranch = C4::Context->userenv->{'branch'};
+
+my %branchmap = map { $_ => 1 } @branch; # for quick lookups
 
 my $backupdir = C4::Context->config('backupdir');
 
 if ( $op eq "export" ) {
-    if ( $format eq "iso2709" or $format eq "xml" ) {
+    if (
+        $output_format eq "iso2709"
+            or $output_format eq "xml"
+            or (
+                $output_format eq 'csv'
+                    and not @biblionumbers
+            )
+    ) {
         my $charset  = 'utf-8';
         my $mimetype = 'application/octet-stream';
-        binmode STDOUT, ':encoding(UTF-8)';
+
+        binmode STDOUT, ':encoding(UTF-8)'
+            if $filename =~ m/\.gz$/
+                or $filename =~ m/\.bz2$/;
+
         if ( $filename =~ m/\.gz$/ ) {
             $mimetype = 'application/x-gzip';
             $charset  = '';
@@ -159,12 +181,10 @@ if ( $op eq "export" ) {
         print $query->header(
             -type       => $mimetype,
             -charset    => $charset,
-            -attachment => $filename
+            -attachment => $filename,
         ) unless ($commandline);
 
         $record_type = $query->param("record_type") unless ($commandline);
-        $output_format = $query->param("output_format") || 'marc'
-          unless ($commandline);
         my $export_remove_fields = $query->param("export_remove_fields");
         my @biblionumbers      = $query->param("biblionumbers");
         my @itemnumbers        = $query->param("itemnumbers");
@@ -206,7 +226,7 @@ if ( $op eq "export" ) {
         my $authtype        = $query->param('authtype');
         my $filefh;
         if ($commandline) {
-            open $filefh,"<", $id_list_file or die "cannot open $id_list_file: $!";
+            open $filefh,"<", $id_list_file or die "cannot open $id_list_file: $!" if $id_list_file;
         } else {
             $filefh = $query->upload("id_list_file");
         }
@@ -245,7 +265,7 @@ if ( $op eq "export" ) {
                         itemstable           => $itemstable,
                         StartingBiblionumber => $StartingBiblionumber,
                         EndingBiblionumber   => $EndingBiblionumber,
-                        branch               => $branch,
+                        branch               => \@branch,
                         start_callnumber     => $start_callnumber,
                         end_callnumber       => $end_callnumber,
                         start_accession      => $start_accession,
@@ -322,7 +342,6 @@ if ( $op eq "export" ) {
             # Someone is trying to mess us up
             exit;
         }
-
         unless (@biblionumbers) {
             my $sth = $dbh->prepare($sql_query);
             $sth->execute(@sql_params);
@@ -363,14 +382,10 @@ if ( $op eq "export" ) {
                         my ( $homebranchfield, $homebranchsubfield ) =
                           GetMarcFromKohaField( 'items.homebranch', '' );
                         for my $itemfield ( $record->field($homebranchfield) ) {
-
-# if stripping nonlocal items, use loggedinuser's branch if they didn't select one
-                            $branch = C4::Context->userenv->{'branch'}
-                              unless $branch;
                             $record->delete_field($itemfield)
                               if ( $dont_export_items
-                                || $itemfield->subfield($homebranchsubfield) ne
-                                $branch );
+                                || $localbranch ne $itemfield->subfield(
+                                        $homebranchsubfield) );
                         }
                     }
                 }
@@ -393,7 +408,7 @@ if ( $op eq "export" ) {
                                     }
                                 }
                                 else {
-                                    $record->delete_fields($field);
+                                    $record->delete_fields($record->field($field));
                                 }
                             }
                         }
@@ -415,10 +430,11 @@ if ( $op eq "export" ) {
                     print MARC::File::XML::record($record);
                     print "\n";
                 }
-                else {
-                    my (@result_build_tag) = MARC::File::USMARC::_build_tag_directory($record);
-                    if ($result_build_tag[2] > 99999) {
-                        warn "record (number $recordid) length ".$result_build_tag[2]." is larger than the MARC spec allows (99999 bytes)";
+                elsif ( $output_format eq 'iso2709' ) {
+                    my $errorcount_on_decode = eval { scalar(MARC::File::USMARC->decode( $record->as_usmarc )->warnings()) };
+                    if ($errorcount_on_decode or $@){
+                        warn $@ if $@;
+                        warn "record (number $recordid) is invalid and therefore not exported because its reopening generates warnings above";
                         next;
                     }
                     print $record->as_usmarc();
@@ -429,15 +445,25 @@ if ( $op eq "export" ) {
             print MARC::File::XML::footer();
             print "\n";
         }
+        if ( $output_format eq 'csv' ) {
+            my $csv_profile_id = $query->param('csv_profile')
+                || GetCsvProfileId( C4::Context->preference('ExportWithCsvProfile') );
+            my $output =
+              marc2csv( \@recordids,
+                $csv_profile_id );
+
+            print $output;
+        }
 
         exit;
     }
-    elsif ( $format eq "csv" ) {
+    elsif ( $output_format eq "csv" ) {
         my @biblionumbers = uniq $query->param("biblionumbers");
         my @itemnumbers   = $query->param("itemnumbers");
+        my $csv_profile_id = $query->param('csv_profile') || GetCsvProfileId( C4::Context->preference('ExportWithCsvProfile') );
         my $output =
           marc2csv( \@biblionumbers,
-            GetCsvProfileId( C4::Context->preference('ExportWithCsvProfile') ),
+            $csv_profile_id,
             \@itemnumbers, );
         print $query->header(
             -type                        => 'application/octet-stream',
@@ -470,7 +496,7 @@ else {
         push @branchloop,
           {
             value      => $thisbranch,
-            selected   => $thisbranch eq $branch,
+            selected   => %branchmap ? $branchmap{$thisbranch} : 1,
             branchname => $branches->{$thisbranch}->{'branchname'},
           };
     }
@@ -511,6 +537,7 @@ else {
         itemtypeloop             => \@itemtypesloop,
         authtypeloop             => \@authtypesloop,
         export_remove_fields     => C4::Context->preference("ExportRemoveFields"),
+        csv_profiles             => C4::Csv::GetCsvProfiles('marc'),
     );
 
     output_html_with_http_headers $query, $cookie, $template->output;
@@ -545,14 +572,14 @@ sub construct_query {
             my $itemstable           = $params->{itemstable};
             my $StartingBiblionumber = $params->{StartingBiblionumber};
             my $EndingBiblionumber   = $params->{EndingBiblionumber};
-            my $branch               = $params->{branch};
+            my @branch               = @{ $params->{branch} };
             my $start_callnumber     = $params->{start_callnumber};
             my $end_callnumber       = $params->{end_callnumber};
             my $start_accession      = $params->{start_accession};
             my $end_accession        = $params->{end_accession};
             my $itemtype             = $params->{itemtype};
             my $items_filter =
-                 $branch
+                 @branch
               || $start_callnumber
               || $end_callnumber
               || $start_accession
@@ -574,9 +601,9 @@ sub construct_query {
                 push @sql_params, $EndingBiblionumber;
             }
 
-            if ($branch) {
-                $sql_query .= " AND homebranch = ? ";
-                push @sql_params, $branch;
+            if (@branch) {
+                $sql_query .= " AND homebranch IN (".join(',',map({'?'} @branch)).")";
+                push @sql_params, @branch;
             }
 
             if ($start_callnumber) {