Add payment module for MerchantWare 4.0 gateway, from Merchant
[interchange.git] / 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