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{__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; } $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