# Table/Import.pm: import a table # # $Id: Import.pm,v 1.24 1999/06/07 08:08:28 mike Exp $ # # Copyright 1995 by Andrew M. Wilcox # Copyright 1996-1999 by Mike Heins # # 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. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. package Vend::Table::Import; $VERSION = substr(q$Revision: 1.24 $, 10); require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(import_csv import_quoted import_ascii_delimited); use strict; use Vend::Table::Quoted qw(read_quoted_fields); use Vend::Util; sub import_csv { my ($source, $options, $table_name) = @_; die "The source file '$source' does not exist\n" unless -e $source; open(Vend::Table::Import::IN, "+<$source") or die "Can't open '$source' read/write: $!\n"; lockfile(\*Vend::Table::Import::IN, 1, 1) or die "lock\n"; my @field_names = read_quoted_fields(\*IN); die "$source is empty\n" unless @field_names; $options->{FIRST_COLUMN_NAME} = shift @field_names; no strict 'refs'; my $out; if($options->{ObjectType}) { $out = &{"$options->{ObjectType}::create"}( $options->{ObjectType}, $options, \@field_names, $table_name, ); } else { $out = $options->{Object}; } my (@fields,$key); while (@fields = read_quoted_fields(\*IN)) { $out->set_row(@fields); } unlockfile(\*Vend::Table::Import::IN) or die "unlock\n"; close(Vend::Table::Import::IN); return $out; } sub import_quoted { return import_csv(@_) } my %Sort = ( '' => sub { $a cmp $b }, none => sub { $a cmp $b }, f => sub { (lc $a) cmp (lc $b) }, fr => sub { (lc $b) cmp (lc $a) }, n => sub { $a <=> $b }, nr => sub { $b <=> $a }, r => sub { $b cmp $a }, rf => sub { (lc $b) cmp (lc $a) }, rn => sub { $b <=> $a }, ); sub import_ascii_delimited { my ($infile, $options, $table_name) = @_; my ($format); my $delimiter = quotemeta($options->{'delimiter'}); $format = uc ($options->{CONTINUE} || 'NONE'); open(Vend::Table::Import::IN, "+<$infile") or die "Couldn't open '$infile' read/write: $!\n"; lockfile(\*Vend::Table::Import::IN, 1, 1) or die "lock\n"; my $field_hash; my $para_sep; my $codere = '[\w-_#/.]+'; my $idx = 0; my($field_count, @field_names); if($options->{field_names}) { @field_names = @{$options->{field_names}}; if($options->{CONTINUE} eq 'NOTES') { $para_sep = $options->{SEPARATOR} || "\f"; $field_hash = {}; for(@field_names) { $field_hash->{$_} = $idx++; } $idx = $#field_names; } } else { my $field_names = ; chomp $field_names; $field_names =~ s/\s+$// unless $format eq 'NOTES'; @field_names = split(/$delimiter/, $field_names); if($format eq 'NOTES') { $field_hash = {}; for(@field_names) { s/:.*//; if(/\S[ \t]+/) { die "Only one notes field allowed in NOTES format.\n" if $para_sep; $para_sep = $_; $_ = ''; } else { $field_hash->{$_} = $idx++; } } my $msg; @field_names = grep $_, @field_names; $para_sep =~ s/($codere)[\t ]*(.)/$2/; push(@field_names, ($1 || 'notes_field')); $idx = $#field_names; if ($para_sep) { $para_sep =~ s/[ \t\r\n].*//; $msg = length($para_sep) != 1 ? "'$para_sep'" : sprintf '0x%02x', ord $para_sep; # ::logError("notes_field='$field_names[$idx]' delimiter: $msg") ::logError( Vend::Util::errmsg('Table/Import.pm:1', "notes_field='%s' delimiter: %s" , $field_names[$idx], $msg) ) if $Vend::Cfg->{DisplayErrors}; } else { $para_sep = "\f"; } push(@field_names, $para_sep); } } local($/) = "\n" . $para_sep ."\n" if $para_sep; $field_count = scalar @field_names; # HACK! $options->{FIRST_COLUMN_NAME} = shift @field_names; no strict 'refs'; my $out; if($options->{ObjectType}) { $out = &{"$options->{ObjectType}::create"}( $options->{ObjectType}, $options, \@field_names, $table_name, ); } else { $out = $options->{Object}; } my $fields; my (@fields, $key); my @addl; my $excel = ''; my $excel_addl = ''; if($options->{EXCEL}) { #Fix for quoted includes supplied by Larry Lesczynski $excel = <<'EndOfExcel'; if(/"[^\t]*(?:,|"")/) { for (@fields) { next unless /[,"]/; s/^"//; s/"$//; s/""/"/g; } } EndOfExcel $excel_addl = <<'EndOfExcel'; if(/"[^\t]*(?:,|"")/) { for (@addl) { next unless /,/; s/^"//; s/"$//; } } EndOfExcel } my $index = ''; my @fh; # Array of file handles for sort my @fc; # Array of file handles for copy when symlink fails my @i; # Array of field names for sort my @o; # Array of sort options if($options->{INDEX}) { my @f; my $f; my @n; my $i; @f = split /[\s,]+/, $options->{INDEX}; foreach $f (@f) { my $found = 0; $i = 1; if( $f =~ s/:(.*)//) { push @o, $1; } else { push @o, ''; } for(@field_names) { if($_ eq $f) { $found++; push(@i, $i); push(@n, $f); last; } $i++; } pop(@o) unless $found; } if(@i) { require IO::File; my $fh; my $f_string = join ",", @i; @f = (); for($i = 0; $i < @i; $i++) { my $fnum = $i[$i]; $fh = new IO::File "> $infile.$i[$i]"; die "Couldn't create $infile.$i[$i]: $!\n" unless defined $fh; eval { unlink "$infile.$n[$i]" if -l "$infile.$n[$i]"; symlink "$infile.$i[$i]", "$infile.$n[$i]"; }; push @fc, ["$infile.$i[$i]", "$infile.$n[$i]"] if $@; push @fh, $fh; $index .= < <) { chomp; \@fields = (); s/\\r?\\n\\r?\\n([\\000-\\377]*)// and \$fields[$idx] = \$1; while(s!($codere):[ \\t]*(.*)\\n?!!) { next unless defined \$field_hash->{\$1}; \$fields[\$field_hash->{\$1}] = \$2; } $index \$key = shift \@fields; \$out->set_row(\$key, \@fields); } EndOfRoutine LINE => <) { chomp; \$fields = \@fields = split(/$delimiter/, \$_, $field_count); $index push (\@fields, '') until \$fields++ >= $field_count; \$key = shift \@fields; \$out->set_row(\$key, \@fields); } EndOfRoutine NONE => <) { chomp; \$fields = \@fields = split(/$delimiter/, \$_, 99999); $excel $index push (\@fields, '') until \$fields++ >= $field_count; \$key = shift \@fields; \$out->set_row(\$key, \@fields); } EndOfRoutine UNIX => <) { chomp; if(s/\\\\\$//) { \$_ .= ; redo; } elsif (s/<<(\\w+)\$//) { my \$mark = \$1; my \$line = \$_; \$line .= Vend::Config::read_here(\\*Vend::Table::Import::IN, \$mark); \$_ = \$line; redo; } \$fields = \@fields = split(/$delimiter/, \$_, 99999); $excel $index push (\@fields, '') until \$fields++ >= $field_count; \$key = shift \@fields; \$out->set_row(\$key, \@fields); } EndOfRoutine DITTO => <) { chomp; if(/^$delimiter/) { \$fields = \@addl = split /$delimiter/, \$_, 99999; shift \@addl; $excel_addl my \$i; for(\$i = 0; \$i < \@addl; \$i++) { \$fields[\$i] .= "\n\$addl[\$i]" if \$addl[\$i] ne ''; } } else { \$fields = \@fields = split(/$delimiter/, \$_, 99999); $excel $index push (\@fields, '') until \$fields++ >= $field_count; \$key = shift \@fields; } \$out->set_row(\$key, \@fields); } EndOfRoutine ); eval $format{$format}; die $@ if $@; if(@fh) { my $no_sort; my $sort_sub; my $ftest = Vend::Util::catfile($Vend::Cfg->{ScratchDir}, 'sort.test'); my $cmd = "echo you_have_no_sort_but_we_will_cope | sort -f -n -o $ftest"; system $cmd; $no_sort = 1 if ! -f $ftest; my $fh; my $i; for ($i = 0; $i < @fh; $i++) { close $fh[$i] or die "close: $!"; unless ($no_sort) { $o[$i] = "-$o[$i]" if $o[$i]; $cmd = "sort $o[$i] -o $infile.$i[$i] $infile.$i[$i]"; system $cmd; } else { $fh = new IO::File "$infile.$i[$i]"; my (@lines) = <$fh>; close $fh or die "close: $!"; my $option = $o[$i] || 'none'; @lines = sort { &{$Sort{$option}} } @lines; $fh = new IO::File ">$infile.$i[$i]"; print $fh @lines; close $fh or die "close: $!"; } } } if(@fc) { require File::Copy; for(@fc) { File::Copy::copy(@{$_}); } } unlockfile(\*Vend::Table::Import::IN) or die "unlock\n"; close(Vend::Table::Import::IN); return $out; } sub version { $Vend::Table::Import::VERSION } 1;