code/UI_Tag/backup_database.coretag

   1 # Copyright 2002-2009 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7
   8 UserTag backup-database Order    tables
   9 UserTag backup-database AddAttr
  10 UserTag backup-database Version  1.11
  11 UserTag backup-database Routine  <<EOR
  12 sub {
  13         my ($tables, $opt) = @_;
  14         my (@tables) = grep /\S/, split /['\s\0]+/, $tables;
  15         my $backup_dir =        $opt->{dir}
  16                                                 || $::Variable->{BACKUP_DIRECTORY}
  17                                                 || "$Vend::Cfg->{VendRoot}/backup";
  18         my $gnum   = $opt->{gnumeric};
  19         my $agg = "$backup_dir/DBDOWNLOAD.all";
  20
  21         my $Max_xls_string = 255;
  22
  23         eval {
  24                 require Compress::Zlib;
  25         } if $opt->{compress};
  26
  27         my $xls;
  28
  29         if ($opt->{xls}) {
  30                 eval {
  31                         require Spreadsheet::WriteExcel;
  32                         import Spreadsheet::WriteExcel;
  33                         $xls = Spreadsheet::WriteExcel->new("$backup_dir/DBDOWNLOAD.xls");
  34                 };
  35                 if ($xls) {
  36                         if ($opt->{max_xls_string}) {
  37                                 $Max_xls_string = int($opt->{max_xls_string}) || 255;
  38                                 $xls->{_xls_strmax} = $Max_xls_string;
  39                         }
  40                 }
  41                 else {
  42                         undef $opt->{xls};
  43                 }
  44         }
  45
  46         my $gz;
  47
  48         my @errors;
  49
  50         if($gnum) {
  51                 open (AGG, ">$agg")
  52                         or die "Cannot write aggregate file $agg; $!\n";
  53         }
  54         my $done = 0;
  55         for my $table (@tables) {
  56                 my $unlink;
  57                 my $db = Vend::Data::database_exists_ref($table);
  58                 my $fn = $db->config('file');
  59                 $fn =~ s:.*/::;
  60                 my $file = "$backup_dir/$fn";
  61                 my $status;
  62                 eval {
  63                         $status = export(
  64                                                 $table,
  65                                                 {
  66                                                         force => 1,
  67                                                         table => $table,
  68                                                         file => $file,
  69                                                         type => 'TAB',
  70                                                         where => $opt->{where},
  71                                                 },
  72                                         );
  73                 };
  74
  75                 if(! $status) {
  76                         push @errors,
  77                                 errmsg(
  78                                                 "Error exporting %s to %s: %s",
  79                                                 $table,
  80                                                 $file,
  81                                                 $@ || 'unspecified',
  82                                         );
  83                         next;
  84                 }
  85
  86                 if($opt->{compress}) {
  87                         my $new = "$file.gz";
  88                         my $gz;
  89                         eval {
  90                                 $gz = Compress::Zlib::gzopen($new, "wb")
  91                                         or die errmsg("error compressing %s to %s: %s", $new, $agg, $!);
  92                                 open(ZIN, $file)
  93                                         or die errmsg("error opening %s: %s", $file, $!);
  94                                 while(<ZIN>) {
  95                                         $gz->gzwrite($_)
  96                                                 or die
  97                                                         errmsg("gzwrite error on %s: %s", $new, $gz->gzerror());
  98                                 }
  99                                 $gz->gzclose();
 100                                 close ZIN;
 101                         };
 102                         if($@) {
 103                                 push @errors, $@;
 104                                 next;
 105                         }
 106                         $unlink = 1;
 107                 }
 108                 if($gnum) {
 109                         print AGG "\f" if $done;
 110                         print AGG "$table\n";
 111                         open(RECENT, $file)
 112                                 or do {
 113                                         push @errors,
 114                                                 errmsg("Can't read written file %s: %s", $file, $!);
 115                                         next;
 116                                 };
 117                         while(<RECENT>) {
 118                                 /\t/ and s/^/'/ and
 119                                         (
 120                                                 s/\t(0\d+)/\t'$1/g,
 121                                                 s/\t\+/\t'+/g,
 122                                                 s/\t( *\d[^\t]*[-A-Za-z ])/\t'$1/g
 123                                         );
 124                                 print AGG;
 125                         }
 126                         close RECENT;
 127                 }
 128                 if($xls) {
 129                         my $sheet = $xls->addworksheet($table);
 130                         $sheet->{_xls_strmax} = $Max_xls_string
 131                                 if defined $opt->{max_xls_string};
 132                         $sheet->activate($table) if $table eq $Vend::Cfg->{ProductFiles}[0];
 133                         open(RECENT, $file)
 134                                 or do {
 135                                         push @errors,
 136                                                 errmsg("Can't read written file %s: %s", $file, $!);
 137                                         next;
 138                                 };
 139                         my $fstring = <RECENT>;
 140                         chomp $fstring;
 141                         my @fields = split /\t/, $fstring;
 142                         my $maxcol = scalar @fields - 1;
 143                         my $j;
 144                         for($j = 0; $j <= $maxcol; $j++) {
 145                                 $sheet->write_string(0, $j, $fields[$j])
 146                                         if length $fields[$j];
 147                         }
 148                         my $i = 1;
 149                         while(<RECENT>) {
 150                                 chomp;
 151                                 my @extra;
 152                                 my @overflow;
 153                                 @fields = split /\t/, $_;
 154                                 for($j = 0; $j <= $maxcol; $j++) {
 155                                         my $l = 0;
 156                                         my $ptr;
 157                                         if ( length($fields[$j]) > $Max_xls_string) {
 158                                                 $overflow[$j] = $fields[$j];
 159                                                 $extra[$j] = [];
 160                                                 while ( length($overflow[$j]) > $Max_xls_string) {
 161                                                         for( ' ', "\n", "&nbsp;" ) {
 162                                                                 $ptr = rindex $overflow[$j], $_, $Max_xls_string;
 163 #::logDebug("char='$_' ptr=$ptr length=" . length($overflow[$j]) ) if $l < 10;
 164                                                                 last if $ptr != -1;
 165                                                         }
 166 #::logDebug("char='$_' ptr=$ptr\nstring=$overflow[$j]") if $l++ < 10;
 167
 168                                                         $ptr = 254 if $ptr < 0;
 169
 170                                                         $ptr++;
 171                                                         my $string = substr $overflow[$j], 0, $ptr;
 172                                                         $overflow[$j] = substr $overflow[$j], $ptr;
 173                                                         push @{$extra[$j]}, $string;
 174                                                 }
 175                                                 push @{$extra[$j]}, $overflow[$j];
 176                                                 $fields[$j] = shift @{$extra[$j]};
 177                                         }
 178                                         $sheet->write_string($i, $j, $fields[$j]);
 179                                 }
 180                                 if(@extra) {
 181                                         my $max = 0;
 182                                         for(@extra) {
 183                                                 next unless $_;
 184                                                 my $current = scalar @$_;
 185                                                 $max = $current if $max < $current;
 186                                         }
 187                                         for (my $k = 0; $k < $max; $k++) {
 188                                                 $i++;
 189                                                 for( $j = 0; $j < scalar @extra; $j++) {
 190                                                         next unless $_;
 191                                                         $sheet->write_string($i, $j, $extra[$j][$k]);
 192                                                 }
 193                                         }
 194                                 }
 195                                 $i++;
 196                         }
 197                         close RECENT;
 198                 }
 199
 200                 unlink($file) if $unlink;
 201                 undef $unlink;
 202                 $done++;
 203         }
 204
 205         close AGG if $opt->{compress};
 206
 207         if($opt->{compress} and $gnum and $gnum =~ /^compress/i) {
 208                 my $file = $agg;
 209                 my $new = "$file.gz";
 210                 eval {
 211                         my $gz = Compress::Zlib::gzopen($new, "wb")
 212                                 or die errmsg("error compressing %s to %s: %s", $new, $agg, $!);
 213                         open(ZIN, $file)
 214                                 or die errmsg("error opening %s: %s", $file, $!);
 215                         while(<ZIN>) {
 216                                 $gz->gzwrite($_)
 217                                         or die
 218                                                 errmsg("gzwrite error on %s: %s", $new, $gz->gzerror());
 219                         }
 220                         $gz->gzclose();
 221                         close ZIN;
 222                 };
 223                 if($@) {
 224                         push @errors, $@;
 225                 }
 226                 else {
 227                         unlink($file);
 228                 }
 229         }
 230         if(@errors) {
 231                 $::Scratch->{ui_error} = '<ul><li>';
 232                 $::Scratch->{ui_error} .= join "</li>\n<li>", @errors;
 233                 $::Scratch->{ui_error} .= '</li></ul>';
 234         }
 235         return $opt->{hide} ? "" : $done;
 236 }
 237 EOR