| import_fields | ||
|---|---|---|
 |
 |
|
| import_fields | ||
|---|---|---|
| |
|
|
import_fields —
| Attribute | Pos. | Req. | Default | Description |
|---|---|---|---|---|
| 'file' | ||||
| filter_field | ||||
| multiple | ||||
| convert | ||||
| transactions | ||||
| autonumber | ||||
| delimiter | ||||
| fields | ||||
| quiet | ||||
| ignore_fields | ||||
| cleanse | ||||
| delete | ||||
| add | ||||
| 'move' | ||||
| dir | ||||
| interpolate | 0 | interpolate input? | ||
| reparse | 1 | interpolate output? |
Interchange 5.9.0:
Source: code/UI_Tag/import_fields.coretag
Lines: 468
# 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.
#
# $Id: import_fields.coretag,v 1.15 2007-08-03 18:17:24 racke Exp $
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{});
$SIG{""} = 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;
}
$k = $db->set_row($k);
$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
| |
|
|
| import |
|
include |