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 C4::Record;
  30 use Getopt::Long;
  31
  32 my $query = new CGI;
  33
  34 my $commandline = 0;
  35 my $op;
  36 my $filename;
  37 my $dbh         = C4::Context->dbh;
  38 my $marcflavour = C4::Context->preference("marcflavour");
  39 my $clean;
  40 my $output_format;
  41 my $dont_export_items;
  42 my $deleted_barcodes;
  43 my $timestamp;
  44 my $record_type;
  45 my $help;
  46
  47 # Checks if the script is called from commandline
  48 if ( scalar @ARGV > 0 ) {
  49
  50     # Getting parameters
  51     $op = 'export';
  52     GetOptions(
  53         'format=s' => \$output_format,
  54         'date=s' => \$timestamp,
  55         'dont_export_items' => \$dont_export_items,
  56         'deleted_barcodes' => \$deleted_barcodes,
  57         'clean' => \$clean,
  58         'filename=s' => \$filename,
  59         'record-type=s' => \$record_type,
  60         'help|?' => \$help
  61     );
  62     $commandline = 1;
  63
  64
  65     if ($help) {
  66         print <<_USAGE_;
  67 export.pl [--format=format] [--date=date] [--record-type=TYPE] [--dont_export_items] [--deleted_barcodes] [--clean] --filename=outputfile
  68
  69
  70  --format=FORMAT        FORMAT is either 'xml' or 'marc' (default)
  71
  72  --date=DATE            DATE should be entered as the 'dateformat' syspref is
  73                         set (dd/mm/yyyy for metric, yyyy-mm-dd for iso,
  74                         mm/dd/yyyy for us) records exported are the ones that
  75                         have been modified since DATE
  76
  77  --record-type=TYPE     TYPE is 'bibs' or 'auths'
  78
  79  --deleted_barcodes     If used, a list of barcodes of items deleted since DATE
  80                         is produced (or from all deleted items if no date is
  81                         specified). Used only if TYPE is 'bibs'
  82
  83  --clean                removes NSE/NSB
  84 _USAGE_
  85         exit;
  86     }
  87
  88     # Default parameters values :
  89     $output_format     ||= 'marc';
  90     $timestamp         ||= '';
  91     $dont_export_items ||= 0;
  92     $deleted_barcodes  ||= 0;
  93     $clean             ||= 0;
  94     $record_type       ||= "bibs";
  95
  96     # Redirect stdout
  97     open STDOUT, ">$filename" if $filename;
  98
  99 } else {
 100
 101     $op          = $query->param("op") || '';
 102     $filename    = $query->param("filename") || 'koha.mrc';
 103     $filename =~ s/(\r|\n)//;
 104
 105 }
 106
 107 my ($template, $loggedinuser, $cookie, $flags) = get_template_and_user(
 108     {
 109         template_name => "tools/export.tmpl",
 110         query => $query,
 111         type => "intranet",
 112         authnotrequired => $commandline,
 113         flagsrequired => {tools => 'export_catalog'},
 114         debug => 1,
 115     }
 116 );
 117
 118 my $limit_ind_branch = (
 119     C4::Context->preference('IndependantBranches') &&
 120     C4::Context->userenv &&
 121     !(C4::Context->userenv->{flags} & 1) &&
 122     C4::Context->userenv->{branch}
 123 ) ? 1 : 0;
 124
 125 my $branch = $query->param("branch") || '';
 126 if ( C4::Context->preference("IndependantBranches") &&
 127      C4::Context->userenv &&
 128      !(C4::Context->userenv->{flags} & 1) ) {
 129     $branch = C4::Context->userenv->{'branch'};
 130 }
 131
 132 my $backupdir = C4::Context->config('backupdir');
 133
 134 if ($op eq "export") {
 135     my $charset  = 'utf-8';
 136     my $mimetype = 'application/octet-stream';
 137     binmode STDOUT, ':encoding(UTF-8)';
 138     if ( $filename =~ m/\.gz$/ ) {
 139         $mimetype = 'application/x-gzip';
 140         $charset = '';
 141         binmode STDOUT;
 142     } elsif ( $filename =~ m/\.bz2$/ ) {
 143         $mimetype = 'application/x-bzip2';
 144         binmode STDOUT;
 145         $charset = '';
 146     }
 147     print $query->header(
 148         -type => $mimetype,
 149         -charset => $charset,
 150         -attachment => $filename
 151     ) unless ($commandline);
 152
 153     $record_type           = $query->param("record_type") unless ($commandline);
 154     $output_format         = $query->param("output_format") || 'marc' unless ($commandline);
 155     my $dont_export_fields = $query->param("dont_export_fields");
 156     my @sql_params;
 157     my $sql_query;
 158
 159     my $StartingBiblionumber = $query->param("StartingBiblionumber");
 160     my $EndingBiblionumber   = $query->param("EndingBiblionumber");
 161     my $itemtype             = $query->param("itemtype");
 162     my $start_callnumber     = $query->param("start_callnumber");
 163     my $end_callnumber       = $query->param("end_callnumber");
 164     $timestamp = ($timestamp) ? C4::Dates->new($timestamp) : '' if ($commandline);
 165     my $start_accession =
 166       ( $query->param("start_accession") )
 167       ? C4::Dates->new( $query->param("start_accession") )
 168       : '';
 169     my $end_accession =
 170       ( $query->param("end_accession") )
 171       ? C4::Dates->new( $query->param("end_accession") )
 172       : '';
 173     $dont_export_items    = $query->param("dont_export_item") unless ($commandline);
 174     my $strip_nonlocal_items = $query->param("strip_nonlocal_items");
 175
 176     my $biblioitemstable = ($commandline and $deleted_barcodes)
 177                                 ? 'deletedbiblioitems'
 178                                 : 'biblioitems';
 179     my $itemstable = ($commandline and $deleted_barcodes)
 180                                 ? 'deleteditems'
 181                                 : 'items';
 182
 183     my $starting_authid = $query->param('starting_authid');
 184     my $ending_authid   = $query->param('ending_authid');
 185     my $authtype        = $query->param('authtype');
 186
 187     if ( $record_type eq 'bibs' ) {
 188         if ($timestamp) {
 189             # Specific query when timestamp is used
 190             # Actually it's used only with CLI and so all previous filters
 191             # are not used.
 192             # If one day timestamp is used via the web interface, this part will
 193             # certainly have to be rewrited
 194             $sql_query = " (
 195                 SELECT biblionumber
 196                 FROM $biblioitemstable
 197                   LEFT JOIN items USING(biblionumber)
 198                 WHERE $biblioitemstable.timestamp >= ?
 199                   OR items.timestamp >= ?
 200             ) UNION (
 201                 SELECT biblionumber
 202                 FROM $biblioitemstable
 203                   LEFT JOIN deleteditems USING(biblionumber)
 204                 WHERE $biblioitemstable.timestamp >= ?
 205                   OR deleteditems.timestamp >= ?
 206             ) ";
 207             my $ts = $timestamp->output('iso');
 208             @sql_params = ($ts, $ts, $ts, $ts);
 209         } else {
 210             my $items_filter =
 211                 $branch || $start_callnumber || $end_callnumber ||
 212                 $start_accession || $timestamp || $end_accession ||
 213                 ($itemtype && C4::Context->preference('item-level_itypes'));
 214             $sql_query = $items_filter ?
 215                 "SELECT DISTINCT $biblioitemstable.biblionumber
 216                 FROM $biblioitemstable JOIN $itemstable
 217                 USING (biblionumber) WHERE 1"
 218                 :
 219                 "SELECT $biblioitemstable.biblionumber FROM $biblioitemstable WHERE biblionumber >0 ";
 220
 221             if ( $StartingBiblionumber ) {
 222                 $sql_query .= " AND $biblioitemstable.biblionumber >= ? ";
 223                 push @sql_params, $StartingBiblionumber;
 224             }
 225
 226             if ( $EndingBiblionumber ) {
 227                 $sql_query .= " AND $biblioitemstable.biblionumber <= ? ";
 228                 push @sql_params, $EndingBiblionumber;
 229             }
 230
 231             if ($branch) {
 232                 $sql_query .= " AND homebranch = ? ";
 233                 push @sql_params, $branch;
 234             }
 235
 236             if ($start_callnumber) {
 237                 $sql_query .= " AND itemcallnumber <= ? ";
 238                 push @sql_params, $start_callnumber;
 239             }
 240
 241             if ($end_callnumber) {
 242                 $sql_query .= " AND itemcallnumber >= ? ";
 243                 push @sql_params, $end_callnumber;
 244             }
 245             if ($start_accession) {
 246                 $sql_query .= " AND dateaccessioned >= ? ";
 247                 push @sql_params, $start_accession->output('iso');
 248             }
 249
 250             if ($end_accession) {
 251                 $sql_query .= " AND dateaccessioned <= ? ";
 252                 push @sql_params, $end_accession->output('iso');
 253             }
 254
 255             if ( $itemtype ) {
 256                 $sql_query .= (C4::Context->preference('item-level_itypes')) ? " AND items.itype = ? " : " AND biblioitems.itemtype = ?";
 257                 push @sql_params, $itemtype;
 258             }
 259         }
 260     }
 261     elsif ( $record_type eq 'auths' ) {
 262         $sql_query =
 263           "SELECT DISTINCT auth_header.authid FROM auth_header WHERE 1";
 264
 265         if ($starting_authid) {
 266             $sql_query .= " AND auth_header.authid >= ? ";
 267             push @sql_params, $starting_authid;
 268         }
 269
 270         if ($ending_authid) {
 271             $sql_query .= " AND auth_header.authid <= ? ";
 272             push @sql_params, $ending_authid;
 273         }
 274
 275         if ($authtype) {
 276             $sql_query .= " AND auth_header.authtypecode = ? ";
 277             push @sql_params, $authtype;
 278         }
 279     }
 280     elsif ( $record_type eq 'db' ) {
 281         my $successful_export;
 282         if ( $flags->{superlibrarian} && C4::Context->config('backup_db_via_tools') ) {
 283             $successful_export = download_backup( { directory => "$backupdir", extension => 'sql', filename => "$filename" } )
 284         }
 285         unless ( $successful_export ) {
 286             my $remotehost = $query->remote_host();
 287             $remotehost =~ s/(\n|\r)//;
 288             warn "A suspicious attempt was made to download the db at '$filename' by someone at " . $remotehost . "\n";
 289         }
 290         exit;
 291     }
 292     elsif ( $record_type eq 'conf' ) {
 293         my $successful_export;
 294         if ( $flags->{superlibrarian} && C4::Context->config('backup_conf_via_tools') ) {
 295             $successful_export = download_backup( { directory => "$backupdir", extension => 'tar', filename => "$filename" } )
 296         }
 297         unless ( $successful_export ) {
 298             my $remotehost = $query->remote_host();
 299             $remotehost =~ s/(\n|\r)//;
 300             warn "A suspicious attempt was made to download the configuration at '$filename' by someone at " . $remotehost . "\n";
 301         }
 302         exit;
 303     }
 304     else {
 305         # Someone is trying to mess us up
 306         exit;
 307     }
 308
 309     my $sth = $dbh->prepare($sql_query);
 310     $sth->execute(@sql_params);
 311
 312     while ( my ($recordid) = $sth->fetchrow ) {
 313         if ( $deleted_barcodes ) {
 314             my $q = "
 315                 SELECT DISTINCT barcode
 316                 FROM deleteditems
 317                 WHERE deleteditems.biblionumber = ?
 318             ";
 319             my $sth = $dbh->prepare($q);
 320             $sth->execute($recordid);
 321             while (my $row = $sth->fetchrow_array) {
 322                 print "$row\n";
 323             }
 324         } else {
 325             my $record;
 326             if ( $record_type eq 'bibs' ) {
 327                 $record = eval { GetMarcBiblio($recordid); };
 328
 329                 if ($@) {
 330                     next;
 331                 }
 332                 next if not defined $record;
 333                 C4::Biblio::EmbedItemsInMarcBiblio( $record, $recordid )
 334                   unless $dont_export_items;
 335                 if ( $strip_nonlocal_items || $limit_ind_branch ) {
 336                     my ( $homebranchfield, $homebranchsubfield ) =
 337                       GetMarcFromKohaField( 'items.homebranch', '' );
 338                     for my $itemfield ( $record->field($homebranchfield) ) {
 339
 340     # if stripping nonlocal items, use loggedinuser's branch if they didn't select one
 341                         $branch = C4::Context->userenv->{'branch'} unless $branch;
 342                         $record->delete_field($itemfield)
 343                           if (
 344                             $itemfield->subfield($homebranchsubfield) ne $branch );
 345                     }
 346                 }
 347             }
 348             elsif ( $record_type eq 'auths' ) {
 349                 $record = C4::AuthoritiesMarc::GetAuthority($recordid);
 350                 next if not defined $record;
 351             }
 352
 353             if ( $dont_export_fields ) {
 354                 my @fields = split " ", $dont_export_fields;
 355                 foreach ( @fields ) {
 356                     /^(\d*)(\w)?$/;
 357                     my $field = $1;
 358                     my $subfield = $2;
 359                     # skip if this record doesn't have this field
 360                     next if not defined $record->field($field);
 361                     if( $subfield ) {
 362                         $record->field($field)->delete_subfields($subfield);
 363                     }
 364                     else {
 365                         $record->delete_field($record->field($field));
 366                     }
 367                 }
 368             }
 369             RemoveAllNsb($record) if ($clean);
 370             if ( $output_format eq "xml" ) {
 371                 if ($marcflavour eq 'UNIMARC' && $record_type eq 'auths') {
 372                     print $record->as_xml_record('UNIMARCAUTH');
 373                 } else {
 374                     print $record->as_xml_record($marcflavour);
 375                 }
 376             }
 377             else {
 378                 print $record->as_usmarc();
 379             }
 380         }
 381     }
 382     exit;
 383
 384 }    # if export
 385
 386 else {
 387
 388     my $itemtypes = GetItemTypes;
 389     my @itemtypesloop;
 390     foreach my $thisitemtype (sort keys %$itemtypes) {
 391         my %row =
 392             (
 393                 value => $thisitemtype,
 394                 description => $itemtypes->{$thisitemtype}->{'description'},
 395             );
 396        push @itemtypesloop, \%row;
 397     }
 398     my $branches = GetBranches($limit_ind_branch);
 399     my @branchloop;
 400     for my $thisbranch (
 401         sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} }
 402         keys %{$branches}
 403       ) {
 404         push @branchloop,
 405           { value      => $thisbranch,
 406             selected   => $thisbranch eq $branch,
 407             branchname => $branches->{$thisbranch}->{'branchname'},
 408           };
 409     }
 410
 411     my $authtypes = getauthtypes;
 412     my @authtypesloop;
 413     foreach my $thisauthtype ( sort keys %$authtypes ) {
 414         next unless $thisauthtype;
 415         my %row = (
 416             value       => $thisauthtype,
 417             description => $authtypes->{$thisauthtype}->{'authtypetext'},
 418         );
 419         push @authtypesloop, \%row;
 420     }
 421
 422     if ( $flags->{superlibrarian} && C4::Context->config('backup_db_via_tools') && $backupdir && -d $backupdir ) {
 423         $template->{VARS}->{'allow_db_export'} = 1;
 424         $template->{VARS}->{'dbfiles'} = getbackupfilelist( { directory => "$backupdir", extension => 'sql' } );
 425     }
 426
 427     if ( $flags->{superlibrarian} && C4::Context->config('backup_conf_via_tools') && $backupdir && -d $backupdir ) {
 428         $template->{VARS}->{'allow_conf_export'} = 1;
 429         $template->{VARS}->{'conffiles'} = getbackupfilelist( { directory => "$backupdir", extension => 'tar' } );
 430     }
 431
 432     $template->param(
 433         branchloop               => \@branchloop,
 434         itemtypeloop             => \@itemtypesloop,
 435         DHTMLcalendar_dateformat => C4::Dates->DHTMLcalendar(),
 436         authtypeloop             => \@authtypesloop,
 437         dont_export_fields       => C4::Context->preference("DontExportFields"),
 438     );
 439
 440     output_html_with_http_headers $query, $cookie, $template->output;
 441 }
 442
 443 sub getbackupfilelist {
 444     my $args = shift;
 445     my $directory = $args->{directory};
 446     my $extension = $args->{extension};
 447     my @files;
 448
 449     if ( opendir(my $dir, $directory) ) {
 450         while (my $file = readdir($dir)) {
 451             next unless ( $file =~ m/\.$extension(\.(gz|bz2|xz))?/ );
 452             push @files, $file if ( -f "$backupdir/$file" && -r "$backupdir/$file" );
 453         }
 454         closedir($dir);
 455     }
 456     return \@files;
 457 }
 458
 459 sub download_backup {
 460     my $args = shift;
 461     my $directory = $args->{directory};
 462     my $extension = $args->{extension};
 463     my $filename  = $args->{filename};
 464
 465     return unless ( $directory && -d $directory );
 466     return unless ( $filename =~ m/$extension(\.(gz|bz2|xz))?$/ && not $filename =~ m#|# );
 467     $filename = "$directory/$filename";
 468     return unless ( -f $filename && -r $filename );
 469     return unless ( open(my $dump, '<', $filename) );
 470     binmode $dump;
 471     while (read($dump, my $data, 64 * 1024)) {
 472         print $data;
 473     }
 474     close ($dump);
 475     return 1;
 476 }