code/UI_Tag/import_fields.coretag

# Copyright 2002-2007 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 import_fields Order   table
UserTag import_fields addAttr
UserTag import_fields Version $Revision: 1.15 $
UserTag import_fields Routine <<EOR
sub {
	my($table, $opt) = @_;
	use strict;
	my $out;
#::logDebug("options for import_fields: " . ::uneval(\@_) );
	local($SIG{__DIE__});
	$SIG{"__DIE__"} = sub {
                            my $msg = shift;
                            ::response(<<EOF);
<HTML><HEAD><TITLE>Fatal Administration Error</TITLE></HEAD><BODY>
<H1>FATAL error</H1>
<P>
<PRE>$msg</PRE>
Progress to date:
<P>
$out
</BODY></HTML>
EOF
                            exit 0;
                        };
	my $file = $opt->{'file'} || $Vend::Cfg->{ProductDir} . "/$table.update";
	my $currdb;
	my $tmsg = '';
	my $db;

	my %filter = ( 
		'' => { mv_credit_card_number => 'encrypt' },
	);

	if($opt->{filter_field}) {
		my @filt = grep /\S/, split /[\r\n]+/, $opt->{filter_field};
		for(@filt) {
			s/^\s+//;
			s/\s+$//;
			my ($t, $f) = split /\s*:\s*/, $_;
			if(! $f) {
				if ($opt->{multiple}) {
					die "Must specify both table and filter for multiple table filters.\n";

				}
				else {
					$f = $t;
					$t = '';
				}
				$t ||= '';
			}
#::logDebug("found filter: t=$t f=$f");
			my ($field, $filters) = split /\s*=\s*/, $f, 2;
#::logDebug("found filter: t=$t field=$field filters=$filters");
			$filter{$t}{$field} = $filters;
		}
	}

	CONVERT: {
		last CONVERT if ! $opt->{convert};
		if ($opt->{convert} eq 'auto') {
			if($file =~ /\.(txt|all)$/i) {
				last CONVERT;
			}
			elsif($file =~ /\.xls$/i) {
				$opt->{convert} = 'xls';
				redo CONVERT;
			}
			else {
				$file =~ s:.*\.::
					or $file = 'none';
				return "Failed: unknown file extension ''";
			}
		}
		elsif ($opt->{convert} eq 'xls') {
#::logDebug("doing XLS for file=$file");
			eval {
				require Spreadsheet::ParseExcel;
				import Spreadsheet::ParseExcel;

				my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($file);
#::logDebug("oBook is $oBook");
				if(! $oBook) {
					die errmsg("Failed to parse XLS file %s: %s\n", $file, $!);
				}
				my($iR, $iC, $oWkS, $oWkC);

				my $sheetcount = $oBook->{SheetCount};
#::logDebug("Sheetcount is $sheetcount");
				my $sheets = {};

					for my $oWkS (@{$oBook->{Worksheet}}) {
					   next unless defined $oWkS;

					   for(qw/MaxCol MaxRow MinCol MinRow/) {
						   die "No $_!"           if ! defined $oWkS->{$_};
					   }

					   my $sname =  $oWkS->{Name} or die "no sheet name.";
#::logDebug("doing sheet $sname");
					   $sheets->{$sname} =  "$sname\n";
					   my $maxcol;
					   my $mincol;

					   my $iC;

					   my $iR = $oWkS->{MinRow};

					   for($iC = $oWkS->{MinCol} ; $iC <= $oWkS->{MaxCol} ; $iC++) {
							   $oWkC = $oWkS->{Cells}[$iR][$iC];
							   if(! $oWkC or ! $oWkC->Value) {
								  $maxcol = $iC;
								  $maxcol--;
								  last;
							   }
							   $maxcol = $iC;
					   }

					   $mincol = $oWkS->{MinCol};
					   my @out;

					   for( ; $iR <= $oWkS->{MaxRow}; $iR++) {
						  my $row = $oWkS->{Cells}[$iR];
						  @out = ();
						  for($iC = $mincol; $iC <= $maxcol; $iC++) {
							if(! defined $row->[$iC]) {
								push @out, "";
								next;
							}
							push @out, $row->[$iC]->Value;
						  }
						  $sheets->{$sname} .= join "\t", @out;
						  $sheets->{$sname} .= "\n";
					   }
					}

					my @print;
					for(sort keys %$sheets) {
						push @print, $sheets->{$_};
					}
					$file =~ s/(\.xls)?$/.txt/i;
					open OUT, ">$file"
						or die "Cannot write $file: $!\n";
					print OUT join "\cL", @print;
					close OUT;
			};
			die "Excel conversion failed: $@\n" if $@;
		}
		else {
			# other types, or assume gnumeric simple text
		}

	} # end CONVERT

	my $change_sub;
	if($opt->{multiple}) {
		undef $table;
		$change_sub = sub {
			my $table = shift;
			$Vend::WriteDatabase{$table} = 1;
			$Vend::TransactionDatabase{$table} = 1 
				if $opt->{transactions};
#::logDebug("changing table to $table");
			$db = Vend::Data::database_exists_ref($table);
#::logDebug("db now=$db");
			die "Non-existent table '$table'\n" unless $db;
			$db = $db->ref();
#::logDebug("db now=$db");
			if($opt->{autonumber} and ! $db->config('_Auto_number') ) {
				 $db->config('AUTO_NUMBER', '1000');
			}
#::logDebug("db now=$db");
			$tmsg = "table $table: ";
			return;
		};
	}
	else {
		$Vend::WriteDatabase{$table} = 1;
		$Vend::TransactionDatabase{$table} = 1 
			if $opt->{transactions};
		$db = Vend::Data::database_exists_ref($table);
		die "Non-existent table '$table'\n" unless $db;
		$db = $db->ref() unless $Vend::Interpolate::Db{$table};
		if($opt->{autonumber} and ! $db->config('_Auto_number') ) {
			 $db->config('AUTO_NUMBER', '1000');
		}
	}

	$out = '<PRE>';
	my $delimiter = quotemeta $opt->{delimiter} || "\t";
	open(UPDATE, $file)
		or die "read $file: $!\n";

	my $fields;

	if($opt->{multiple}) {
		# will get fields later
		undef $opt->{fields};
	}
	elsif($opt->{fields}) {
		$fields = $opt->{fields};
		$out .= "Using fields from parameter: '$fields'\n";
	}

	my $verbose;
	my $quiet;

	$verbose = 1 if ! $opt->{quiet};
	$quiet = 1   if $opt->{quiet} > 1;

  TABLE: {
	if(! $table) {
		$table = <UPDATE>;
		$table =~ s/(\015\012|\015|\012)$//;
		$change_sub->($table);
	}
#::logDebug("db now=$db");
	if(! $opt->{fields}) {
		$fields = <UPDATE>;
		$fields =~ s/(\015\012|\015|\012)$//;
		$fields =~ s/$delimiter/ /g;
		$out .= "${tmsg}Using fields from file: '$fields'\n";
	}
	$filter{$table} ||= {};
	die "No field names." if ! $fields;
	my @names;
	my $k;
	my @f;
	@names = split /\s+/, $fields;
	my $key = shift @names;
	my $i = 0;
	my $idx = 0;
	my $ignore_sub;
	
	# check key name
	if ($key !~ /^[\w_-]+$/) {
		die "Invalid key '$key' for table $table (wrong file format ?)\n";
	}

	my $multikey = $db->config('COMPOSITE_KEY') ? 1 : 0;

	
	if ($opt->{ignore_fields}) {
		my %fmap;
		for (my $ct = 0; $ct < @names; $ct++) {
			$fmap{$names[$ct]} = $ct;
		}
		for (split(/[\0\s,]+/, $opt->{ignore_fields})) {
			delete $fmap{$_};
		}
		my $code = 'sub {$a = shift; @$a = @$a[' . join(',', values(%fmap)) . '];}';
		$ignore_sub = eval $code;
		die "Routine to ignore fields bad: $@" if $@;
		@names = grep {exists $fmap{$_}} @names;
	}

	# We skip the whole table if bad field is found
	my $skipping;

	my @keycols;

	if($multikey) {
		my %fmap;
		@fmap{$key,@names} = ($key,@names);
		my $not_all_there;
		for(@{$db->config('_Key_columns')}) {
			push(@keycols, $_);
			next if $fmap{$_};	
			$not_all_there = 1;
		}
		if($not_all_there) {
			$out .= errmsg(
						"Table %s: not all key columns present. Skipping table.",
						$table,
					);

			$skipping = 1;
		}
	}

	######### Filters
	##
	## Done with so many data items for speed when empty....
	##

	## Holds filter subroutines if any
	my %change;
	## Holds names of filter subroutines if any
	my @filters;
	## Non-zero if found any filter
	my $found_filter = 0;
	##
	######### Filters

	for(@names) {
		my $test = $db->column_index($_);
#::logDebug("checking name=$_");
		if(! defined $test) {
			$out .= errmsg(
						"Table %s: undefined column '%s'. Skipping table.",
						$table,
						$_,
						);
			$skipping = 1;
		}
		elsif ($filter{''}{$_} || $filter{$table}{$_}) {
#::logDebug("found filter for name=$_");
			my @things = grep length($_), $filter{''}{$_}, $filter{$table}{$_};
			my $thing = join " ", @things;
			eval {
				$change{$_} = sub {
					my $ref = shift;
					$$ref = Vend::Interpolate::filter_value($thing, $$ref);
				};
			};
			if($@) {
				$out .= errmsg(
							"Table %s: unrequited filter '%s'. Skipping table.",
							$table,
							$thing,
						);
				$skipping = 1;
			}
			push @filters, $_;
			$found_filter++;
		}
		$idx++;
	}
	my %keys;
	if ($opt->{cleanse}) {
		# record existing columns
		my $recs;
		if ($multikey) {
			$recs = $db->query("select " . join(',', @keycols) . " from $table");
			$keys{join("\0", @$_)} = 1 for @$recs;
		} else {
			$recs = $db->query("select $key from $table");
			$keys{$_->[0]} = 1 for @$recs;
		}
	}
	my $count = 0;
	my $totcount = 0;
	my $delcount = 0;
	my $addcount = 0;
	while(<UPDATE>) {
		s/(\015\012|\015|\012)$//;
		$totcount++;
		($k, @f) = split /$delimiter/o, $_;
		if(/^\f(\w+)$/) {
			$out .= "${tmsg}$count records processed of $totcount input lines.\n";
			$out .= "${tmsg}$delcount records deleted.\n" if $delcount;
			$out .= "${tmsg}$addcount records added.\n" if $addcount;
			$delcount = $totcount = $addcount = 0;
			$db->commit() if $opt->{transactions};
			$change_sub->($1);
			redo TABLE;
		}
		next if $skipping;
		if(! $k and ! length($k)) {
			if ($f[0] eq 'DELETE') {
				next if ! $opt->{delete};
				next if $multikey;
				$out .= "${tmsg}Deleting record '$f[1]'.\n" if $verbose;
				$db->delete_record($f[1]);
				$count++;
				$delcount++;
				next;
			}
		}
		$ignore_sub->(\@f) if $ignore_sub;
		$out .= "${tmsg}Record '$k' had too many fields, ignored.\n"
			if @f > $idx;

		my %hash;
		@hash{@names} = @f;
		if($found_filter) {
			for(@filters) {
				$change{$_}->(\$hash{$_});
			}
		}

		if($multikey) {
			$hash{$key} = $k;
			if(! $db->record_exists(\%hash)) {
				if($opt->{add}) {
					$out .= "${tmsg}Adding multiple-key record.\n" if $verbose;
				}
				else {
					$out .= "${tmsg}Non-existent record '$k', skipping.\n";
					next;
				}
			}
			$k = undef;
		}
		elsif ( ! length($k) or ! $db->record_exists($k)) {
			if ($opt->{add}) {
				if( ! length($k) and ! $opt->{autonumber}) {
					$out .= "${tmsg}Blank key, no autonumber option, skipping.\n";
					next;
				}
				$out .= "${tmsg}Adding record '$k'.\n" if $verbose;
				$addcount++;
			}
			else {
				$out .= "${tmsg}Non-existent record '$k', skipping.\n";
				next;
			}
		}

		if ($opt->{cleanse}) {
			if ($multikey) {
				delete $keys{join("\0", map{$hash{$_}} @keycols)};
			} else {
				delete $keys{$k};
			}
		}

		$db->set_slice($k, \%hash) if @names;

		if($@) {
   			my $msg = ::errmsg("error on update: %s", $@);
			::logError($msg);
   			$out .= $msg;
   		}
		$count++;
	}

	$db->commit() if $opt->{transactions};

	if ($opt->{cleanse}) {
		# remove any record which hasn't updated
		for (keys(%keys)) {
			$db->delete_record($_);
			$delcount++;
		}
	}
	$out .= "${tmsg}$count records processed of $totcount input lines.\n";
	$out .= "${tmsg}$delcount records deleted.\n" if $delcount;
	$out .= "${tmsg}$addcount records added.\n" if $addcount;
  }
	$out .= "</PRE>";
	close UPDATE;
	if($opt->{'move'}) {
		my $ext = POSIX::strftime("%Y%m%d%H%M%S", localtime());
		rename $file, "$file.$ext"
			or die "rename $file --> $file.$ext: $!\n";
		if(	$opt->{dir}
			and (-d $opt->{dir} or File::Path::mkpath($opt->{dir}))
			and -w $opt->{dir}
			)
		{
			File::Copy::move("$file.$ext", $opt->{dir})
				or die "move $file.$ext --> $opt->{dir}: $!\n";
		}
	}
	return $out unless $quiet;
	return;
}
EOR