# 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