Name

import_fields —

ATTRIBUTES

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?

DESCRIPTION

BEHAVIOR

This tag does not appear to be affected by, or affect, the rest of Interchange.

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

AVAILABILITY

import_fields is available in Interchange versions:

4.6.0-5.7.0 (git-head)

SOURCE

Interchange 5.7.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

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!