code/UI_Tag/import_fields.coretag

   1 # Copyright 2002-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: import_fields.coretag,v 1.15 2007-08-03 18:17:24 racke Exp $
   9
  10 UserTag import_fields Order   table
  11 UserTag import_fields addAttr
  12 UserTag import_fields Version $Revision: 1.15 $
  13 UserTag import_fields Routine <<EOR
  14 sub {
  15         my($table, $opt) = @_;
  16         use strict;
  17         my $out;
  18 #::logDebug("options for import_fields: " . ::uneval(\@_) );
  19         local($SIG{__DIE__});
  20         $SIG{"__DIE__"} = sub {
  21                             my $msg = shift;
  22                             ::response(<<EOF);
  23 <HTML><HEAD><TITLE>Fatal Administration Error</TITLE></HEAD><BODY>
  24 <H1>FATAL error</H1>
  25 <P>
  26 <PRE>$msg</PRE>
  27 Progress to date:
  28 <P>
  29 $out
  30 </BODY></HTML>
  31 EOF
  32                             exit 0;
  33                         };
  34         my $file = $opt->{'file'} || $Vend::Cfg->{ProductDir} . "/$table.update";
  35         my $currdb;
  36         my $tmsg = '';
  37         my $db;
  38
  39         my %filter = (
  40                 '' => { mv_credit_card_number => 'encrypt' },
  41         );
  42
  43         if($opt->{filter_field}) {
  44                 my @filt = grep /\S/, split /[\r\n]+/, $opt->{filter_field};
  45                 for(@filt) {
  46                         s/^\s+//;
  47                         s/\s+$//;
  48                         my ($t, $f) = split /\s*:\s*/, $_;
  49                         if(! $f) {
  50                                 if ($opt->{multiple}) {
  51                                         die "Must specify both table and filter for multiple table filters.\n";
  52
  53                                 }
  54                                 else {
  55                                         $f = $t;
  56                                         $t = '';
  57                                 }
  58                                 $t ||= '';
  59                         }
  60 #::logDebug("found filter: t=$t f=$f");
  61                         my ($field, $filters) = split /\s*=\s*/, $f, 2;
  62 #::logDebug("found filter: t=$t field=$field filters=$filters");
  63                         $filter{$t}{$field} = $filters;
  64                 }
  65         }
  66
  67         CONVERT: {
  68                 last CONVERT if ! $opt->{convert};
  69                 if ($opt->{convert} eq 'auto') {
  70                         if($file =~ /\.(txt|all)$/i) {
  71                                 last CONVERT;
  72                         }
  73                         elsif($file =~ /\.xls$/i) {
  74                                 $opt->{convert} = 'xls';
  75                                 redo CONVERT;
  76                         }
  77                         else {
  78                                 $file =~ s:.*\.::
  79                                         or $file = 'none';
  80                                 return "Failed: unknown file extension ''";
  81                         }
  82                 }
  83                 elsif ($opt->{convert} eq 'xls') {
  84 #::logDebug("doing XLS for file=$file");
  85                         eval {
  86                                 require Spreadsheet::ParseExcel;
  87                                 import Spreadsheet::ParseExcel;
  88
  89                                 my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($file);
  90 #::logDebug("oBook is $oBook");
  91                                 if(! $oBook) {
  92                                         die errmsg("Failed to parse XLS file %s: %s\n", $file, $!);
  93                                 }
  94                                 my($iR, $iC, $oWkS, $oWkC);
  95
  96                                 my $sheetcount = $oBook->{SheetCount};
  97 #::logDebug("Sheetcount is $sheetcount");
  98                                 my $sheets = {};
  99
 100                                         for my $oWkS (@{$oBook->{Worksheet}}) {
 101                                            next unless defined $oWkS;
 102
 103                                            for(qw/MaxCol MaxRow MinCol MinRow/) {
 104                                                    die "No $_!"           if ! defined $oWkS->{$_};
 105                                            }
 106
 107                                            my $sname =  $oWkS->{Name} or die "no sheet name.";
 108 #::logDebug("doing sheet $sname");
 109                                            $sheets->{$sname} =  "$sname\n";
 110                                            my $maxcol;
 111                                            my $mincol;
 112
 113                                            my $iC;
 114
 115                                            my $iR = $oWkS->{MinRow};
 116
 117                                            for($iC = $oWkS->{MinCol} ; $iC <= $oWkS->{MaxCol} ; $iC++) {
 118                                                            $oWkC = $oWkS->{Cells}[$iR][$iC];
 119                                                            if(! $oWkC or ! $oWkC->Value) {
 120                                                                   $maxcol = $iC;
 121                                                                   $maxcol--;
 122                                                                   last;
 123                                                            }
 124                                                            $maxcol = $iC;
 125                                            }
 126
 127                                            $mincol = $oWkS->{MinCol};
 128                                            my @out;
 129
 130                                            for( ; $iR <= $oWkS->{MaxRow}; $iR++) {
 131                                                   my $row = $oWkS->{Cells}[$iR];
 132                                                   @out = ();
 133                                                   for($iC = $mincol; $iC <= $maxcol; $iC++) {
 134                                                         if(! defined $row->[$iC]) {
 135                                                                 push @out, "";
 136                                                                 next;
 137                                                         }
 138                                                         push @out, $row->[$iC]->Value;
 139                                                   }
 140                                                   $sheets->{$sname} .= join "\t", @out;
 141                                                   $sheets->{$sname} .= "\n";
 142                                            }
 143                                         }
 144
 145                                         my @print;
 146                                         for(sort keys %$sheets) {
 147                                                 push @print, $sheets->{$_};
 148                                         }
 149                                         $file =~ s/(\.xls)?$/.txt/i;
 150                                         open OUT, ">$file"
 151                                                 or die "Cannot write $file: $!\n";
 152                                         print OUT join "\cL", @print;
 153                                         close OUT;
 154                         };
 155                         die "Excel conversion failed: $@\n" if $@;
 156                 }
 157                 else {
 158                         # other types, or assume gnumeric simple text
 159                 }
 160
 161         } # end CONVERT
 162
 163         my $change_sub;
 164         if($opt->{multiple}) {
 165                 undef $table;
 166                 $change_sub = sub {
 167                         my $table = shift;
 168                         $Vend::WriteDatabase{$table} = 1;
 169                         $Vend::TransactionDatabase{$table} = 1
 170                                 if $opt->{transactions};
 171 #::logDebug("changing table to $table");
 172                         $db = Vend::Data::database_exists_ref($table);
 173 #::logDebug("db now=$db");
 174                         die "Non-existent table '$table'\n" unless $db;
 175                         $db = $db->ref();
 176 #::logDebug("db now=$db");
 177                         if($opt->{autonumber} and ! $db->config('_Auto_number') ) {
 178                                  $db->config('AUTO_NUMBER', '1000');
 179                         }
 180 #::logDebug("db now=$db");
 181                         $tmsg = "table $table: ";
 182                         return;
 183                 };
 184         }
 185         else {
 186                 $Vend::WriteDatabase{$table} = 1;
 187                 $Vend::TransactionDatabase{$table} = 1
 188                         if $opt->{transactions};
 189                 $db = Vend::Data::database_exists_ref($table);
 190                 die "Non-existent table '$table'\n" unless $db;
 191                 $db = $db->ref() unless $Vend::Interpolate::Db{$table};
 192                 if($opt->{autonumber} and ! $db->config('_Auto_number') ) {
 193                          $db->config('AUTO_NUMBER', '1000');
 194                 }
 195         }
 196
 197         $out = '<PRE>';
 198         my $delimiter = quotemeta $opt->{delimiter} || "\t";
 199         open(UPDATE, $file)
 200                 or die "read $file: $!\n";
 201
 202         my $fields;
 203
 204         if($opt->{multiple}) {
 205                 # will get fields later
 206                 undef $opt->{fields};
 207         }
 208         elsif($opt->{fields}) {
 209                 $fields = $opt->{fields};
 210                 $out .= "Using fields from parameter: '$fields'\n";
 211         }
 212
 213         my $verbose;
 214         my $quiet;
 215
 216         $verbose = 1 if ! $opt->{quiet};
 217         $quiet = 1   if $opt->{quiet} > 1;
 218
 219   TABLE: {
 220         if(! $table) {
 221                 $table = <UPDATE>;
 222                 $table =~ s/(\015\012|\015|\012)$//;
 223                 $change_sub->($table);
 224         }
 225 #::logDebug("db now=$db");
 226         if(! $opt->{fields}) {
 227                 $fields = <UPDATE>;
 228                 $fields =~ s/(\015\012|\015|\012)$//;
 229                 $fields =~ s/$delimiter/ /g;
 230                 $out .= "${tmsg}Using fields from file: '$fields'\n";
 231         }
 232         $filter{$table} ||= {};
 233         die "No field names." if ! $fields;
 234         my @names;
 235         my $k;
 236         my @f;
 237         @names = split /\s+/, $fields;
 238         my $key = shift @names;
 239         my $i = 0;
 240         my $idx = 0;
 241         my $ignore_sub;
 242
 243         # check key name
 244         if ($key !~ /^[\w_-]+$/) {
 245                 die "Invalid key '$key' for table $table (wrong file format ?)\n";
 246         }
 247
 248         my $multikey = $db->config('COMPOSITE_KEY') ? 1 : 0;
 249
 250
 251         if ($opt->{ignore_fields}) {
 252                 my %fmap;
 253                 for (my $ct = 0; $ct < @names; $ct++) {
 254                         $fmap{$names[$ct]} = $ct;
 255                 }
 256                 for (split(/[\0\s,]+/, $opt->{ignore_fields})) {
 257                         delete $fmap{$_};
 258                 }
 259                 my $code = 'sub {$a = shift; @$a = @$a[' . join(',', values(%fmap)) . '];}';
 260                 $ignore_sub = eval $code;
 261                 die "Routine to ignore fields bad: $@" if $@;
 262                 @names = grep {exists $fmap{$_}} @names;
 263         }
 264
 265         # We skip the whole table if bad field is found
 266         my $skipping;
 267
 268         my @keycols;
 269
 270         if($multikey) {
 271                 my %fmap;
 272                 @fmap{$key,@names} = ($key,@names);
 273                 my $not_all_there;
 274                 for(@{$db->config('_Key_columns')}) {
 275                         push(@keycols, $_);
 276                         next if $fmap{$_};
 277                         $not_all_there = 1;
 278                 }
 279                 if($not_all_there) {
 280                         $out .= errmsg(
 281                                                 "Table %s: not all key columns present. Skipping table.",
 282                                                 $table,
 283                                         );
 284
 285                         $skipping = 1;
 286                 }
 287         }
 288
 289         ######### Filters
 290         ##
 291         ## Done with so many data items for speed when empty....
 292         ##
 293
 294         ## Holds filter subroutines if any
 295         my %change;
 296         ## Holds names of filter subroutines if any
 297         my @filters;
 298         ## Non-zero if found any filter
 299         my $found_filter = 0;
 300         ##
 301         ######### Filters
 302
 303         for(@names) {
 304                 my $test = $db->column_index($_);
 305 #::logDebug("checking name=$_");
 306                 if(! defined $test) {
 307                         $out .= errmsg(
 308                                                 "Table %s: undefined column '%s'. Skipping table.",
 309                                                 $table,
 310                                                 $_,
 311                                                 );
 312                         $skipping = 1;
 313                 }
 314                 elsif ($filter{''}{$_} || $filter{$table}{$_}) {
 315 #::logDebug("found filter for name=$_");
 316                         my @things = grep length($_), $filter{''}{$_}, $filter{$table}{$_};
 317                         my $thing = join " ", @things;
 318                         eval {
 319                                 $change{$_} = sub {
 320                                         my $ref = shift;
 321                                         $$ref = Vend::Interpolate::filter_value($thing, $$ref);
 322                                 };
 323                         };
 324                         if($@) {
 325                                 $out .= errmsg(
 326                                                         "Table %s: unrequited filter '%s'. Skipping table.",
 327                                                         $table,
 328                                                         $thing,
 329                                                 );
 330                                 $skipping = 1;
 331                         }
 332                         push @filters, $_;
 333                         $found_filter++;
 334                 }
 335                 $idx++;
 336         }
 337         my %keys;
 338         if ($opt->{cleanse}) {
 339                 # record existing columns
 340                 my $recs;
 341                 if ($multikey) {
 342                         $recs = $db->query("select " . join(',', @keycols) . " from $table");
 343                         $keys{join("\0", @$_)} = 1 for @$recs;
 344                 } else {
 345                         $recs = $db->query("select $key from $table");
 346                         $keys{$_->[0]} = 1 for @$recs;
 347                 }
 348         }
 349         my $count = 0;
 350         my $totcount = 0;
 351         my $delcount = 0;
 352         my $addcount = 0;
 353         while(<UPDATE>) {
 354                 s/(\015\012|\015|\012)$//;
 355                 $totcount++;
 356                 ($k, @f) = split /$delimiter/o, $_;
 357                 if(/^\f(\w+)$/) {
 358                         $out .= "${tmsg}$count records processed of $totcount input lines.\n";
 359                         $out .= "${tmsg}$delcount records deleted.\n" if $delcount;
 360                         $out .= "${tmsg}$addcount records added.\n" if $addcount;
 361                         $delcount = $totcount = $addcount = 0;
 362                         $db->commit() if $opt->{transactions};
 363                         $change_sub->($1);
 364                         redo TABLE;
 365                 }
 366                 next if $skipping;
 367                 if(! $k and ! length($k)) {
 368                         if ($f[0] eq 'DELETE') {
 369                                 next if ! $opt->{delete};
 370                                 next if $multikey;
 371                                 $out .= "${tmsg}Deleting record '$f[1]'.\n" if $verbose;
 372                                 $db->delete_record($f[1]);
 373                                 $count++;
 374                                 $delcount++;
 375                                 next;
 376                         }
 377                 }
 378                 $ignore_sub->(\@f) if $ignore_sub;
 379                 $out .= "${tmsg}Record '$k' had too many fields, ignored.\n"
 380                         if @f > $idx;
 381
 382                 my %hash;
 383                 @hash{@names} = @f;
 384                 if($found_filter) {
 385                         for(@filters) {
 386                                 $change{$_}->(\$hash{$_});
 387                         }
 388                 }
 389
 390                 if($multikey) {
 391                         $hash{$key} = $k;
 392                         if(! $db->record_exists(\%hash)) {
 393                                 if($opt->{add}) {
 394                                         $out .= "${tmsg}Adding multiple-key record.\n" if $verbose;
 395                                 }
 396                                 else {
 397                                         $out .= "${tmsg}Non-existent record '$k', skipping.\n";
 398                                         next;
 399                                 }
 400                         }
 401                         $k = undef;
 402                 }
 403                 elsif ( ! length($k) or ! $db->record_exists($k)) {
 404                         if ($opt->{add}) {
 405                                 if( ! length($k) and ! $opt->{autonumber}) {
 406                                         $out .= "${tmsg}Blank key, no autonumber option, skipping.\n";
 407                                         next;
 408                                 }
 409                                 $k = $db->set_row($k);
 410                                 $out .= "${tmsg}Adding record '$k'.\n" if $verbose;
 411                                 $addcount++;
 412                         }
 413                         else {
 414                                 $out .= "${tmsg}Non-existent record '$k', skipping.\n";
 415                                 next;
 416                         }
 417                 }
 418
 419                 if ($opt->{cleanse}) {
 420                         if ($multikey) {
 421                                 delete $keys{join("\0", map{$hash{$_}} @keycols)};
 422                         } else {
 423                                 delete $keys{$k};
 424                         }
 425                 }
 426
 427                 $db->set_slice($k, \%hash) if @names;
 428
 429                 if($@) {
 430                         my $msg = ::errmsg("error on update: %s", $@);
 431                         ::logError($msg);
 432                         $out .= $msg;
 433                 }
 434                 $count++;
 435         }
 436
 437         $db->commit() if $opt->{transactions};
 438
 439         if ($opt->{cleanse}) {
 440                 # remove any record which hasn't updated
 441                 for (keys(%keys)) {
 442                         $db->delete_record($_);
 443                         $delcount++;
 444                 }
 445         }
 446         $out .= "${tmsg}$count records processed of $totcount input lines.\n";
 447         $out .= "${tmsg}$delcount records deleted.\n" if $delcount;
 448         $out .= "${tmsg}$addcount records added.\n" if $addcount;
 449   }
 450         $out .= "</PRE>";
 451         close UPDATE;
 452         if($opt->{'move'}) {
 453                 my $ext = POSIX::strftime("%Y%m%d%H%M%S", localtime());
 454                 rename $file, "$file.$ext"
 455                         or die "rename $file --> $file.$ext: $!\n";
 456                 if(     $opt->{dir}
 457                         and (-d $opt->{dir} or File::Path::mkpath($opt->{dir}))
 458                         and -w $opt->{dir}
 459                         )
 460                 {
 461                         File::Copy::move("$file.$ext", $opt->{dir})
 462                                 or die "move $file.$ext --> $opt->{dir}: $!\n";
 463                 }
 464         }
 465         return $out unless $quiet;
 466         return;
 467 }
 468 EOR