[interchange-cvs] interchange - racke modified code/UI_Tag/import_fields.coretag

interchange-core@icdevgroup.org interchange-core@icdevgroup.org
Tue Apr 1 08:55:00 2003


User:      racke
Date:      2003-04-01 13:54:17 GMT
Modified:  code/UI_Tag import_fields.coretag
Log:
new parameter ignore_fields added

Revision  Changes    Path
1.7       +17 -1     interchange/code/UI_Tag/import_fields.coretag


rev 1.7, prev_rev 1.6
Index: import_fields.coretag
===================================================================
RCS file: /anon_cvs/repository/interchange/code/UI_Tag/import_fields.coretag,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- import_fields.coretag	12 Jan 2003 18:28:45 -0000	1.6
+++ import_fields.coretag	1 Apr 2003 13:54:17 -0000	1.7
@@ -1,6 +1,6 @@
 UserTag import_fields Order table
 UserTag import_fields addAttr
-UserTag import_fields Version $Revision: 1.6 $
+UserTag import_fields Version $Revision: 1.7 $
 UserTag import_fields Routine <<EOR
 sub {
 	my($table, $opt) = @_;
@@ -229,6 +229,21 @@
 	my $key = shift @names;
 	my $i = 0;
 	my $idx = 0;
+	my $ignore_sub;
+	
+	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;
+	}
 
 	######### Filters
 	##
@@ -314,6 +329,7 @@
 				next;
 			}
 		}
+		$ignore_sub->(\@f) if $ignore_sub;
 		$out .= "${tmsg}Record '$k' had too many fields, ignored.\n"
 			if @f > $idx;
 		if ( ! length($k) or ! $db->record_exists($k)) {