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