Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
238 lines (223 sloc) 5.48 KB
# Copyright 2002-2016 Interchange Development Group and others
#
# This program 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. See the LICENSE file for details.
UserTag backup-database Order tables
UserTag backup-database AddAttr
UserTag backup-database Version 1.12
UserTag backup-database Routine <<EOR
sub {
my ($tables, $opt) = @_;
my (@tables) = grep /\S/, split /['\s\0]+/, $tables;
my $backup_dir = $opt->{dir}
|| $::Variable->{BACKUP_DIRECTORY}
|| "$Vend::Cfg->{VendRoot}/backup";
my $gnum = $opt->{gnumeric};
my $agg = "$backup_dir/DBDOWNLOAD.all";
my $Max_xls_string = 255;
eval {
require Compress::Zlib;
} if $opt->{compress};
my $xls;
if ($opt->{xls}) {
eval {
require Spreadsheet::WriteExcel;
import Spreadsheet::WriteExcel;
$xls = Spreadsheet::WriteExcel->new("$backup_dir/DBDOWNLOAD.xls");
};
if ($xls) {
if ($opt->{max_xls_string}) {
$Max_xls_string = int($opt->{max_xls_string}) || 255;
$xls->{_xls_strmax} = $Max_xls_string;
}
}
else {
undef $opt->{xls};
}
}
my $gz;
my @errors;
if($gnum) {
open (AGG, ">$agg")
or die "Cannot write aggregate file $agg; $!\n";
}
my $done = 0;
for my $table (@tables) {
my $unlink;
my $db = Vend::Data::database_exists_ref($table);
my $fn = $db->config('file');
$fn =~ s:.*/::;
my $file = "$backup_dir/$fn";
my $status;
local $Vend::Cfg->{NoExportExternal} if $opt->{force};
eval {
$status = export(
$table,
{
force => 1,
table => $table,
file => $file,
type => 'TAB',
where => $opt->{where},
},
);
};
if(! $status) {
push @errors,
errmsg(
"Error exporting %s to %s: %s",
$table,
$file,
$@ || 'unspecified',
);
next;
}
if($opt->{compress}) {
my $new = "$file.gz";
my $gz;
eval {
$gz = Compress::Zlib::gzopen($new, "wb")
or die errmsg("error compressing %s to %s: %s", $new, $agg, $!);
open(ZIN, $file)
or die errmsg("error opening %s: %s", $file, $!);
while(<ZIN>) {
$gz->gzwrite($_)
or die
errmsg("gzwrite error on %s: %s", $new, $gz->gzerror());
}
$gz->gzclose();
close ZIN;
};
if($@) {
push @errors, $@;
next;
}
$unlink = 1;
}
if($gnum) {
print AGG "\f" if $done;
print AGG "$table\n";
open(RECENT, $file)
or do {
push @errors,
errmsg("Can't read written file %s: %s", $file, $!);
next;
};
while(<RECENT>) {
/\t/ and s/^/'/ and
(
s/\t(0\d+)/\t'$1/g,
s/\t\+/\t'+/g,
s/\t( *\d[^\t]*[-A-Za-z ])/\t'$1/g
);
print AGG;
}
close RECENT;
}
if($xls) {
my $sheet = $xls->addworksheet($table);
$sheet->{_xls_strmax} = $Max_xls_string
if defined $opt->{max_xls_string};
$sheet->activate($table) if $table eq $Vend::Cfg->{ProductFiles}[0];
open(RECENT, $file)
or do {
push @errors,
errmsg("Can't read written file %s: %s", $file, $!);
next;
};
my $fstring = <RECENT>;
chomp $fstring;
my @fields = split /\t/, $fstring;
my $maxcol = scalar @fields - 1;
my $j;
for($j = 0; $j <= $maxcol; $j++) {
$sheet->write_string(0, $j, $fields[$j])
if length $fields[$j];
}
my $i = 1;
while(<RECENT>) {
chomp;
my @extra;
my @overflow;
@fields = split /\t/, $_;
for($j = 0; $j <= $maxcol; $j++) {
my $l = 0;
my $ptr;
if ( length($fields[$j]) > $Max_xls_string) {
$overflow[$j] = $fields[$j];
$extra[$j] = [];
while ( length($overflow[$j]) > $Max_xls_string) {
for( ' ', "\n", "&nbsp;" ) {
$ptr = rindex $overflow[$j], $_, $Max_xls_string;
#::logDebug("char='$_' ptr=$ptr length=" . length($overflow[$j]) ) if $l < 10;
last if $ptr != -1;
}
#::logDebug("char='$_' ptr=$ptr\nstring=$overflow[$j]") if $l++ < 10;
$ptr = 254 if $ptr < 0;
$ptr++;
my $string = substr $overflow[$j], 0, $ptr;
$overflow[$j] = substr $overflow[$j], $ptr;
push @{$extra[$j]}, $string;
}
push @{$extra[$j]}, $overflow[$j];
$fields[$j] = shift @{$extra[$j]};
}
$sheet->write_string($i, $j, $fields[$j]);
}
if(@extra) {
my $max = 0;
for(@extra) {
next unless $_;
my $current = scalar @$_;
$max = $current if $max < $current;
}
for (my $k = 0; $k < $max; $k++) {
$i++;
for( $j = 0; $j < scalar @extra; $j++) {
next unless $_;
$sheet->write_string($i, $j, $extra[$j][$k]);
}
}
}
$i++;
}
close RECENT;
}
unlink($file) if $unlink;
undef $unlink;
$done++;
}
close AGG if $opt->{compress};
if($opt->{compress} and $gnum and $gnum =~ /^compress/i) {
my $file = $agg;
my $new = "$file.gz";
eval {
my $gz = Compress::Zlib::gzopen($new, "wb")
or die errmsg("error compressing %s to %s: %s", $new, $agg, $!);
open(ZIN, $file)
or die errmsg("error opening %s: %s", $file, $!);
while(<ZIN>) {
$gz->gzwrite($_)
or die
errmsg("gzwrite error on %s: %s", $new, $gz->gzerror());
}
$gz->gzclose();
close ZIN;
};
if($@) {
push @errors, $@;
}
else {
unlink($file);
}
}
if(@errors) {
$::Scratch->{ui_error} = '<ul><li>';
$::Scratch->{ui_error} .= join "</li>\n<li>", @errors;
$::Scratch->{ui_error} .= '</li></ul>';
}
return $opt->{hide} ? "" : $done;
}
EOR
You can’t perform that action at this time.