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 under the
   7 # terms of the GNU General Public License as published by the Free Software
   8 # Foundation; either version 2 of the License, or (at your option) any later
   9 # version.
  10 #
  11 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  12 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License along with
  16 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  17 # Suite 330, Boston, MA  02111-1307 USA
  18
  19
  20 use strict;
  21 use warnings;
  22 use C4::Auth;
  23 use C4::Output;
  24 use C4::Biblio;  # GetMarcBiblio GetXmlBiblio
  25 use C4::AuthoritiesMarc; # GetAuthority
  26 use CGI;
  27 use C4::Koha;    # GetItemTypes
  28 use C4::Branch;  # GetBranches
  29 use Data::Dumper;
  30
  31 my $query = new CGI;
  32 my $op=$query->param("op") || '';
  33 my $filename=$query->param("filename");
  34 my $dbh=C4::Context->dbh;
  35 my $marcflavour = C4::Context->preference("marcflavour");
  36
  37 my ($template, $loggedinuser, $cookie, $flags)
  38     = get_template_and_user
  39     (
  40         {
  41             template_name => "tools/export.tmpl",
  42             query => $query,
  43             type => "intranet",
  44             authnotrequired => 0,
  45             flagsrequired => {tools => 'export_catalog'},
  46             debug => 1,
  47             }
  48     );
  49
  50         my $limit_ind_branch=(C4::Context->preference('IndependantBranches') &&
  51               C4::Context->userenv &&
  52               !(C4::Context->userenv->{flags} & 1) &&
  53               C4::Context->userenv->{branch}?1:0);
  54         my $branches = GetBranches($limit_ind_branch);
  55     my $branch                = $query->param("branch") || '';
  56         if ( C4::Context->preference("IndependantBranches") &&
  57          !(C4::Context->userenv->{flags} & 1) ) {
  58         $branch = C4::Context->userenv->{'branch'};
  59         }
  60
  61 my $backupdir = C4::Context->config('backupdir');
  62
  63 if ($op eq "export") {
  64     my $charset  = 'utf-8';
  65     my $mimetype = 'application/octet-stream';
  66     binmode STDOUT, ':encoding(UTF-8)';
  67     if ( $filename =~ m/\.gz$/ ) {
  68         $mimetype = 'application/x-gzip';
  69         $charset = '';
  70         binmode STDOUT;
  71     } elsif ( $filename =~ m/\.bz2$/ ) {
  72         $mimetype = 'application/x-bzip2';
  73         binmode STDOUT;
  74         $charset = '';
  75     }
  76     print $query->header(   -type => $mimetype,
  77                             -charset => $charset,
  78                             -attachment=>$filename);
  79
  80     my $record_type        = $query->param("record_type");
  81     my $output_format      = $query->param("output_format");
  82     my $dont_export_fields = $query->param("dont_export_fields");
  83     my @sql_params;
  84     my $sql_query;
  85
  86     my $StartingBiblionumber = $query->param("StartingBiblionumber");
  87     my $EndingBiblionumber   = $query->param("EndingBiblionumber");
  88     my $itemtype             = $query->param("itemtype");
  89     my $start_callnumber     = $query->param("start_callnumber");
  90     my $end_callnumber       = $query->param("end_callnumber");
  91     my $start_accession =
  92       ( $query->param("start_accession") )
  93       ? C4::Dates->new( $query->param("start_accession") )
  94       : '';
  95     my $end_accession =
  96       ( $query->param("end_accession") )
  97       ? C4::Dates->new( $query->param("end_accession") )
  98       : '';
  99     my $dont_export_items    = $query->param("dont_export_item");
 100     my $strip_nonlocal_items = $query->param("strip_nonlocal_items");
 101
 102     my $starting_authid = $query->param('starting_authid');
 103     my $ending_authid   = $query->param('ending_authid');
 104     my $authtype        = $query->param('authtype');
 105
 106     if ( $record_type eq 'bibs' ) {
 107         my $items_filter =
 108             $branch || $start_callnumber || $end_callnumber ||
 109             $start_accession || $end_accession ||
 110             ($itemtype && C4::Context->preference('item-level_itypes'));
 111         $sql_query = $items_filter ?
 112             "SELECT DISTINCT biblioitems.biblionumber
 113             FROM biblioitems JOIN items
 114             USING (biblionumber) WHERE 1"
 115             :
 116             "SELECT biblioitems.biblionumber FROM biblioitems WHERE biblionumber >0 ";
 117
 118         if ( $StartingBiblionumber ) {
 119             $sql_query .= " AND biblioitems.biblionumber >= ? ";
 120             push @sql_params, $StartingBiblionumber;
 121         }
 122
 123         if ( $EndingBiblionumber ) {
 124             $sql_query .= " AND biblioitems.biblionumber <= ? ";
 125             push @sql_params, $EndingBiblionumber;
 126         }
 127
 128         if ($branch) {
 129             $sql_query .= " AND homebranch = ? ";
 130             push @sql_params, $branch;
 131         }
 132
 133         if ($start_callnumber) {
 134             $sql_query .= " AND itemcallnumber <= ? ";
 135             push @sql_params, $start_callnumber;
 136         }
 137
 138         if ($end_callnumber) {
 139             $sql_query .= " AND itemcallnumber >= ? ";
 140             push @sql_params, $end_callnumber;
 141         }
 142         if ($start_accession) {
 143             $sql_query .= " AND dateaccessioned >= ? ";
 144             push @sql_params, $start_accession->output('iso');
 145         }
 146
 147         if ($end_accession) {
 148             $sql_query .= " AND dateaccessioned <= ? ";
 149             push @sql_params, $end_accession->output('iso');
 150         }
 151
 152         if ( $itemtype ) {
 153             $sql_query .= (C4::Context->preference('item-level_itypes')) ? " AND items.itype = ? " : " AND biblioitems.itemtype = ?";
 154             push @sql_params, $itemtype;
 155         }
 156     }
 157     elsif ( $record_type eq 'auths' ) {
 158         $sql_query =
 159           "SELECT DISTINCT auth_header.authid FROM auth_header WHERE 1";
 160
 161         if ($starting_authid) {
 162             $sql_query .= " AND auth_header.authid >= ? ";
 163             push @sql_params, $starting_authid;
 164         }
 165
 166         if ($ending_authid) {
 167             $sql_query .= " AND auth_header.authid <= ? ";
 168             push @sql_params, $ending_authid;
 169         }
 170
 171         if ($authtype) {
 172             $sql_query .= " AND auth_header.authtypecode = ? ";
 173             push @sql_params, $authtype;
 174         }
 175     }
 176     elsif ( $record_type eq 'db' ) {
 177         my $successful_export;
 178         if ( $flags->{superlibrarian} && C4::Context->config('backup_db_via_tools') ) {
 179             $successful_export = download_backup( { directory => "$backupdir", extension => 'sql', filename => "$filename" } )
 180         }
 181         unless ( $successful_export ) {
 182             warn "A suspicious attempt was made to download the db at '$filename' by someone at " . $query->remote_host() . "\n";
 183         }
 184         exit;
 185     }
 186     elsif ( $record_type eq 'conf' ) {
 187         my $successful_export;
 188         if ( $flags->{superlibrarian} && C4::Context->config('backup_conf_via_tools') ) {
 189             $successful_export = download_backup( { directory => "$backupdir", extension => 'tar', filename => "$filename" } )
 190         }
 191         unless ( $successful_export ) {
 192             warn "A suspicious attempt was made to download the configuration at '$filename' by someone at " . $query->remote_host() . "\n";
 193         }
 194         exit;
 195     }
 196     else {
 197         # Someone is trying to mess us up
 198         exit;
 199     }
 200
 201     my $sth = $dbh->prepare($sql_query);
 202     $sth->execute(@sql_params);
 203
 204     while ( my ($recordid) = $sth->fetchrow ) {
 205         my $record;
 206         if ( $record_type eq 'bibs' ) {
 207             $record = eval { GetMarcBiblio($recordid); };
 208
 209      # FIXME: decide how to handle records GetMarcBiblio can't parse or retrieve
 210             if ($@) {
 211                 next;
 212             }
 213             next if not defined $record;
 214             C4::Biblio::EmbedItemsInMarcBiblio( $record, $recordid )
 215               unless $dont_export_items;
 216             if ( $strip_nonlocal_items || $limit_ind_branch ) {
 217                 my ( $homebranchfield, $homebranchsubfield ) =
 218                   GetMarcFromKohaField( 'items.homebranch', '' );
 219                 for my $itemfield ( $record->field($homebranchfield) ) {
 220
 221 # if stripping nonlocal items, use loggedinuser's branch if they didn't select one
 222                     $branch = C4::Context->userenv->{'branch'} unless $branch;
 223                     $record->delete_field($itemfield)
 224                       if (
 225                         $itemfield->subfield($homebranchsubfield) ne $branch );
 226                 }
 227             }
 228         }
 229         elsif ( $record_type eq 'auths' ) {
 230             $record = C4::AuthoritiesMarc::GetAuthority($recordid);
 231             next if not defined $record;
 232         }
 233
 234         if ( $dont_export_fields ) {
 235             my @fields = split " ", $dont_export_fields;
 236             foreach ( @fields ) {
 237                 /^(\d*)(\w)?$/;
 238                 my $field = $1;
 239                 my $subfield = $2;
 240                 # skip if this record doesn't have this field
 241                 next if not defined $record->field($field);
 242                 if( $subfield ) {
 243                     $record->field($field)->delete_subfields($subfield);
 244                 }
 245                 else {
 246                     $record->delete_field($record->field($field));
 247                 }
 248             }
 249         }
 250         if ( $output_format eq "xml" ) {
 251             if ($marcflavour eq 'UNIMARC' && $record_type eq 'auths') {
 252                 print $record->as_xml_record('UNIMARCAUTH');
 253             } else {
 254                 print $record->as_xml_record($marcflavour);
 255             }
 256         }
 257         else {
 258             print $record->as_usmarc();
 259         }
 260     }
 261     exit;
 262
 263 }    # if export
 264
 265 else {
 266
 267     my $itemtypes = GetItemTypes;
 268     my @itemtypesloop;
 269     foreach my $thisitemtype (sort keys %$itemtypes) {
 270         my %row =
 271             (
 272                 value => $thisitemtype,
 273                 description => $itemtypes->{$thisitemtype}->{'description'},
 274             );
 275        push @itemtypesloop, \%row;
 276     }
 277     my @branchloop;
 278     for my $thisbranch (
 279         sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} }
 280         keys %{$branches}
 281       ) {
 282         push @branchloop,
 283           { value      => $thisbranch,
 284             selected   => $thisbranch eq $branch,
 285             branchname => $branches->{$thisbranch}->{'branchname'},
 286           };
 287     }
 288
 289     my $authtypes = getauthtypes;
 290     my @authtypesloop;
 291     foreach my $thisauthtype ( sort keys %$authtypes ) {
 292         next unless $thisauthtype;
 293         my %row = (
 294             value       => $thisauthtype,
 295             description => $authtypes->{$thisauthtype}->{'authtypetext'},
 296         );
 297         push @authtypesloop, \%row;
 298     }
 299
 300     if ( $flags->{superlibrarian} && C4::Context->config('backup_db_via_tools') && $backupdir && -d $backupdir ) {
 301         $template->{VARS}->{'allow_db_export'} = 1;
 302         $template->{VARS}->{'dbfiles'} = getbackupfilelist( { directory => "$backupdir", extension => 'sql' } );
 303     }
 304
 305     if ( $flags->{superlibrarian} && C4::Context->config('backup_conf_via_tools') && $backupdir && -d $backupdir ) {
 306         $template->{VARS}->{'allow_conf_export'} = 1;
 307         $template->{VARS}->{'conffiles'} = getbackupfilelist( { directory => "$backupdir", extension => 'tar' } );
 308     }
 309
 310     $template->param(
 311         branchloop               => \@branchloop,
 312         itemtypeloop             => \@itemtypesloop,
 313         DHTMLcalendar_dateformat => C4::Dates->DHTMLcalendar(),
 314         authtypeloop             => \@authtypesloop,
 315     );
 316
 317     output_html_with_http_headers $query, $cookie, $template->output;
 318 }
 319
 320 sub getbackupfilelist {
 321     my $args = shift;
 322     my $directory = $args->{directory};
 323     my $extension = $args->{extension};
 324     my @files;
 325
 326     if ( opendir(my $dir, $directory) ) {
 327         while (my $file = readdir($dir)) {
 328             next unless ( $file =~ m/\.$extension(\.(gz|bz2|xz))?/ );
 329             push @files, $file if ( -f "$backupdir/$file" && -r "$backupdir/$file" );
 330         }
 331         closedir($dir);
 332     }
 333     return \@files;
 334 }
 335
 336 sub download_backup {
 337     my $args = shift;
 338     my $directory = $args->{directory};
 339     my $extension = $args->{extension};
 340     my $filename  = $args->{filename};
 341
 342     return unless ( $directory && -d $directory );
 343     return unless ( $filename =~ m/$extension(\.(gz|bz2|xz))?$/ && not $filename =~ m#(^\.\.|/)# );
 344     $filename = "$directory/$filename";
 345     return unless ( -f $filename && -r $filename );
 346     return unless ( open(my $dump, '<', $filename) );
 347     binmode $dump;
 348     while (read($dump, my $data, 64 * 1024)) {
 349         print $data;
 350     }
 351     close ($dump);
 352     return 1;
 353 }