4 # This file is part of Koha.
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
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.
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
24 use C4
::Biblio
; # GetMarcBiblio GetXmlBiblio
25 use C4
::AuthoritiesMarc
; # GetAuthority
27 use C4
::Koha
; # GetItemTypes
28 use C4
::Branch
; # GetBranches
32 my $op=$query->param("op") || '';
33 my $filename=$query->param("filename");
34 $filename =~ s/(\r|\n)//;
35 my $dbh=C4
::Context
->dbh;
36 my $marcflavour = C4
::Context
->preference("marcflavour");
38 my ($template, $loggedinuser, $cookie, $flags)
39 = get_template_and_user
42 template_name
=> "tools/export.tmpl",
46 flagsrequired
=> {tools
=> 'export_catalog'},
51 my $limit_ind_branch=(C4
::Context
->preference('IndependantBranches') &&
52 C4
::Context
->userenv &&
53 !(C4
::Context
->userenv->{flags
} & 1) &&
54 C4
::Context
->userenv->{branch
}?
1:0);
55 my $branches = GetBranches
($limit_ind_branch);
56 my $branch = $query->param("branch") || '';
57 if ( C4
::Context
->preference("IndependantBranches") &&
58 !(C4
::Context
->userenv->{flags
} & 1) ) {
59 $branch = C4
::Context
->userenv->{'branch'};
62 my $backupdir = C4
::Context
->config('backupdir');
64 if ($op eq "export") {
65 my $charset = 'utf-8';
66 my $mimetype = 'application/octet-stream';
67 binmode STDOUT
, ':encoding(UTF-8)';
68 if ( $filename =~ m/\.gz$/ ) {
69 $mimetype = 'application/x-gzip';
72 } elsif ( $filename =~ m/\.bz2$/ ) {
73 $mimetype = 'application/x-bzip2';
77 print $query->header( -type
=> $mimetype,
79 -attachment
=>$filename);
81 my $record_type = $query->param("record_type");
82 my $output_format = $query->param("output_format");
83 my $dont_export_fields = $query->param("dont_export_fields");
87 my $StartingBiblionumber = $query->param("StartingBiblionumber");
88 my $EndingBiblionumber = $query->param("EndingBiblionumber");
89 my $itemtype = $query->param("itemtype");
90 my $start_callnumber = $query->param("start_callnumber");
91 my $end_callnumber = $query->param("end_callnumber");
93 ( $query->param("start_accession") )
94 ? C4
::Dates
->new( $query->param("start_accession") )
97 ( $query->param("end_accession") )
98 ? C4
::Dates
->new( $query->param("end_accession") )
100 my $dont_export_items = $query->param("dont_export_item");
101 my $strip_nonlocal_items = $query->param("strip_nonlocal_items");
103 my $starting_authid = $query->param('starting_authid');
104 my $ending_authid = $query->param('ending_authid');
105 my $authtype = $query->param('authtype');
107 if ( $record_type eq 'bibs' ) {
109 $branch || $start_callnumber || $end_callnumber ||
110 $start_accession || $end_accession ||
111 ($itemtype && C4
::Context
->preference('item-level_itypes'));
112 $sql_query = $items_filter ?
113 "SELECT DISTINCT biblioitems.biblionumber
114 FROM biblioitems JOIN items
115 USING (biblionumber) WHERE 1"
117 "SELECT biblioitems.biblionumber FROM biblioitems WHERE biblionumber >0 ";
119 if ( $StartingBiblionumber ) {
120 $sql_query .= " AND biblioitems.biblionumber >= ? ";
121 push @sql_params, $StartingBiblionumber;
124 if ( $EndingBiblionumber ) {
125 $sql_query .= " AND biblioitems.biblionumber <= ? ";
126 push @sql_params, $EndingBiblionumber;
130 $sql_query .= " AND homebranch = ? ";
131 push @sql_params, $branch;
134 if ($start_callnumber) {
135 $sql_query .= " AND itemcallnumber <= ? ";
136 push @sql_params, $start_callnumber;
139 if ($end_callnumber) {
140 $sql_query .= " AND itemcallnumber >= ? ";
141 push @sql_params, $end_callnumber;
143 if ($start_accession) {
144 $sql_query .= " AND dateaccessioned >= ? ";
145 push @sql_params, $start_accession->output('iso');
148 if ($end_accession) {
149 $sql_query .= " AND dateaccessioned <= ? ";
150 push @sql_params, $end_accession->output('iso');
154 $sql_query .= (C4
::Context
->preference('item-level_itypes')) ?
" AND items.itype = ? " : " AND biblioitems.itemtype = ?";
155 push @sql_params, $itemtype;
158 elsif ( $record_type eq 'auths' ) {
160 "SELECT DISTINCT auth_header.authid FROM auth_header WHERE 1";
162 if ($starting_authid) {
163 $sql_query .= " AND auth_header.authid >= ? ";
164 push @sql_params, $starting_authid;
167 if ($ending_authid) {
168 $sql_query .= " AND auth_header.authid <= ? ";
169 push @sql_params, $ending_authid;
173 $sql_query .= " AND auth_header.authtypecode = ? ";
174 push @sql_params, $authtype;
177 elsif ( $record_type eq 'db' ) {
178 my $successful_export;
179 if ( $flags->{superlibrarian
} && C4
::Context
->config('backup_db_via_tools') ) {
180 $successful_export = download_backup
( { directory
=> "$backupdir", extension
=> 'sql', filename
=> "$filename" } )
182 unless ( $successful_export ) {
183 my $remotehost = $query->remote_host();
184 $remotehost =~ s/(\n|\r)//;
185 warn "A suspicious attempt was made to download the db at '$filename' by someone at " . $remotehost . "\n";
189 elsif ( $record_type eq 'conf' ) {
190 my $successful_export;
191 if ( $flags->{superlibrarian
} && C4
::Context
->config('backup_conf_via_tools') ) {
192 $successful_export = download_backup
( { directory
=> "$backupdir", extension
=> 'tar', filename
=> "$filename" } )
194 unless ( $successful_export ) {
195 my $remotehost = $query->remote_host();
196 $remotehost =~ s/(\n|\r)//;
197 warn "A suspicious attempt was made to download the configuration at '$filename' by someone at " . $remotehost . "\n";
202 # Someone is trying to mess us up
206 my $sth = $dbh->prepare($sql_query);
207 $sth->execute(@sql_params);
209 while ( my ($recordid) = $sth->fetchrow ) {
211 if ( $record_type eq 'bibs' ) {
212 $record = eval { GetMarcBiblio
($recordid); };
214 # FIXME: decide how to handle records GetMarcBiblio can't parse or retrieve
218 next if not defined $record;
219 C4
::Biblio
::EmbedItemsInMarcBiblio
( $record, $recordid )
220 unless $dont_export_items;
221 if ( $strip_nonlocal_items || $limit_ind_branch ) {
222 my ( $homebranchfield, $homebranchsubfield ) =
223 GetMarcFromKohaField
( 'items.homebranch', '' );
224 for my $itemfield ( $record->field($homebranchfield) ) {
226 # if stripping nonlocal items, use loggedinuser's branch if they didn't select one
227 $branch = C4
::Context
->userenv->{'branch'} unless $branch;
228 $record->delete_field($itemfield)
230 $itemfield->subfield($homebranchsubfield) ne $branch );
234 elsif ( $record_type eq 'auths' ) {
235 $record = C4
::AuthoritiesMarc
::GetAuthority
($recordid);
236 next if not defined $record;
239 if ( $dont_export_fields ) {
240 my @fields = split " ", $dont_export_fields;
241 foreach ( @fields ) {
245 # skip if this record doesn't have this field
246 next if not defined $record->field($field);
248 $record->field($field)->delete_subfields($subfield);
251 $record->delete_field($record->field($field));
255 if ( $output_format eq "xml" ) {
256 if ($marcflavour eq 'UNIMARC' && $record_type eq 'auths') {
257 print $record->as_xml_record('UNIMARCAUTH');
259 print $record->as_xml_record($marcflavour);
263 print $record->as_usmarc();
272 my $itemtypes = GetItemTypes
;
274 foreach my $thisitemtype (sort keys %$itemtypes) {
277 value
=> $thisitemtype,
278 description
=> $itemtypes->{$thisitemtype}->{'description'},
280 push @itemtypesloop, \
%row;
284 sort { $branches->{$a}->{branchname
} cmp $branches->{$b}->{branchname
} }
288 { value
=> $thisbranch,
289 selected
=> $thisbranch eq $branch,
290 branchname
=> $branches->{$thisbranch}->{'branchname'},
294 my $authtypes = getauthtypes
;
296 foreach my $thisauthtype ( sort keys %$authtypes ) {
297 next unless $thisauthtype;
299 value
=> $thisauthtype,
300 description
=> $authtypes->{$thisauthtype}->{'authtypetext'},
302 push @authtypesloop, \
%row;
305 if ( $flags->{superlibrarian
} && C4
::Context
->config('backup_db_via_tools') && $backupdir && -d
$backupdir ) {
306 $template->{VARS
}->{'allow_db_export'} = 1;
307 $template->{VARS
}->{'dbfiles'} = getbackupfilelist
( { directory
=> "$backupdir", extension
=> 'sql' } );
310 if ( $flags->{superlibrarian
} && C4
::Context
->config('backup_conf_via_tools') && $backupdir && -d
$backupdir ) {
311 $template->{VARS
}->{'allow_conf_export'} = 1;
312 $template->{VARS
}->{'conffiles'} = getbackupfilelist
( { directory
=> "$backupdir", extension
=> 'tar' } );
316 branchloop
=> \
@branchloop,
317 itemtypeloop
=> \
@itemtypesloop,
318 DHTMLcalendar_dateformat
=> C4
::Dates
->DHTMLcalendar(),
319 authtypeloop
=> \
@authtypesloop,
322 output_html_with_http_headers
$query, $cookie, $template->output;
325 sub getbackupfilelist
{
327 my $directory = $args->{directory
};
328 my $extension = $args->{extension
};
331 if ( opendir(my $dir, $directory) ) {
332 while (my $file = readdir($dir)) {
333 next unless ( $file =~ m/\.$extension(\.(gz|bz2|xz))?/ );
334 push @files, $file if ( -f
"$backupdir/$file" && -r
"$backupdir/$file" );
341 sub download_backup
{
343 my $directory = $args->{directory
};
344 my $extension = $args->{extension
};
345 my $filename = $args->{filename
};
347 return unless ( $directory && -d
$directory );
348 return unless ( $filename =~ m/$extension(\.(gz|bz2|xz))?$/ && not $filename =~ m
#|# );
349 $filename = "$directory/$filename";
350 return unless ( -f
$filename && -r
$filename );
351 return unless ( open(my $dump, '<', $filename) );
353 while (read($dump, my $data, 64 * 1024)) {