Hi,
I am trying to create a CGI script that will take a CSV file and
convert it to a tilde-separated values file. The file should be sent
to the browser so the user can choose to select-all the text or save
the page as a text file. The problem is that the browser does not
appear to be showing the converted text, just the original csv text.
So given 2 lines like this:
GRALEA00,MIKE,KAY,MP1,09/01/2006
HEINEM00,EMMA,LYNCH,MP1,09/01/2006
I would like output like this:
~GRALEA00~MIKE~KAY~MP1~09/01/2006
~HEINEM00~EMMA~LYNCH~MP1~09/01/2006
It is strange because the output to STDERR looks correct and if I run
a snippet of code on the command line it works as I'd expect.
I am not sure if there is something wrong with my logic or my
understanding of the http headers.
There is another curiosity: If the browser is IE, it asks the user to
save/open the file. If you open (and have perl installed) it tries to
run the the file ~cgi-bin/convert-csv.pl?. I have tried using the
content-disposition header but this doesn't appear to make a
difference. Any tips here would be useful.
The script and some sample data are below.
Thanx in advance.
Dp.
================== convert-csv.pl ===========
#!/usr/bin/perl -w
#############
# import a csv file into a tilde separated file or vice-versa
###############
use CGI;
use CGI::Carp qw(fatalsToBrowser);
$CGI::POST_MAX = 1024 * 1000; # Set limit to 1MB
use strict;
use warnings;
use Text::ParseWords;
my $q = new CGI;
my $state = get_state($q);
if (! defined($state) ) {
# If this is the first time it's run create a input form.
print $q->header(-type=>'text/html',
-expires=>'now',
);
print $q->start_html(
-BGCOLOR => '#777777',
-script =>{-language => 'JAVASCRIPT',
-src => '/js/convert-csv.js',
},
-style =>{-src=>'/css/convert-csv.css'},
);
print $q->start_form(
-enctype => "multipart/form-data",
-method => 'post',
-name => 'convertfile',
# -action => "/cgi-bin/convert-csv.pl",
);
print "Import ";
print $q->filefield(-name=>'uploaded_file',
-size=>30,
-maxlength=>100);
print "<p>";
print "<div id='buttons' name='buttons' class='buttons'>";
print $q->button(-name=>'csv',
-value=>'csv to tilde',
-onClick=>"Convert('csv')",
);
my $nb;
# Would love to use an image here but don't know how!
for ($nb = 0;$nb < 8;++$nb) {
print " ";
}
print $q->button(-name=>'tsv',
-value=>'tilde to csv',
-onClick=>"Convert('tsv')",
);
print "</div>";
print $q->hidden("filetype","");
print $q->end_html;
}
else {
my $filename = $q->param('uploaded_file');
my $csv_type = $q->param('filetype');
print $q->header(-type=>'text',
-expires=>'now',
-Content-Disposition=>"$filename",
);
my $filename = $q->param('uploaded_file');
my $csv_type = $q->param('filetype');
my $untainted_filename;
my $type = $q->uploadInfo($filename)->{'Content-Type'};
unless ($type eq 'text/plain' or 'text/html') {
print STDERR "Type = $type\n";
die "Text files only";
}
if (! $filename && $q->cgi_error) {
print $q->header(-status=>$q->cgi_error);
exit 0;
}
(my $tmp_name = $filename) =~ s/\W+/_/g;
if ($tmp_name =~ /^([-\@:\/\\\w.]+)$/) {
$untainted_filename = $1;
}
else {
die <<"EOT";
Unsupported characters in the filename "$tmp_name".
Your filename may only contain alphabetic characters and numbers,
and the characters '_', '-', '\@', '/', '\\' and '.'
EOT
}
my $output_file = "/tmp/"."$tmp_name".".tmp";
my ($bytesread,$buffer);
my $numbytes = 1024;
# Read in input file and create.
open(OUT, ">$output_file") or die "Can't open $output_file: $!\n";
while ( $bytesread = read($filename, $buffer, $numbytes)) {
print OUT $buffer;
print $buffer;
}
close(OUT);
# set the input file type
my $delim;
my $fld_sep;
if ( $csv_type =~ /csv/) {
$delim = ',';
$fld_sep = "~";
}
else {
$delim = '~';
$fld_sep = ",";
}
print STDERR "Type=$csv_type, Delimiter = \"$delim\", field separator
= \"$fld_sep\"\n";
open(FH,$output_file) or die "Can't open $output_file to conversion:
$!\n";
while (<FH>) {
# s/\W//;
# s/\t//;
# tr/"\x7f"//;
# tr/"[FFF]"//;
# tr/"[\201-\377]"/"[\001-\177]"/;
# print STDERR "Delimiter = \"$delim\", new field separator =
\"$fld_sep\"\n";
my @words = parse_line($delim,0,$_);
foreach my $w (@words) {
s/$delim//;
print STDERR $w.$fld_sep;
print $w.$fld_sep;
}
}
unlink($output_file);
}
sub get_state {
my $q = shift;
return undef unless $q->param();
my $state = {};
my @names = $q->param;
foreach (@names ) {
my $f = $q->param($_);
$state->{$_} = $q->param($_);
# print STDERR "$_ => $f\n";
}
return $state;
}
====================================
======== Input file =====================
AFFINI00,KERRY,WHITE,MP1,09/01/2006
CORMAR00,HANNAH,LONG,MP1,09/01/2006
PUBLIC00,SAM,PATON-SMITH,MP1,09/01/2006
HOOGAL00,DAVE,WESTLAND,MP1,09/01/2006
RIZKMC00,JOHN,MCCAY,MP1,09/01/2006
MCSAAT00,EMILY,TAYLOR,MP1,09/01/2006
WUNDER00,ANNA,GAUGHAN,MP1,09/01/2006
PANADV00,MARTIN,VILLARD,MP1,09/01/2006
ALLKYT00,CLIVE,DURBIN,MP1,09/01/2006
MCDPOS00,LINDA,MCDONALD,MP1,09/01/2006
GIRBOO00,SIMON,DALEY,MP1,09/01/2006
LIFCAR00,ROGER,HENWOOD,MP1,09/01/2006
CAMUNI20,WILNA,BOTHA,MP1,09/01/2006
PHIALL00,RACHEL,FURSE,MP1,09/01/2006
KENGRA00,EMILY,HOOTON,MP1,09/01/2006
INSGUI00,JENNY,CROUSE,MP1,09/01/2006
INSGUI00,HILARY,GENIN,MP1,09/01/2006
REEPRI00,ALEXANDRA,TATTAM,MP1,09/01/2006
TOUCAN00,CHRISTINE,HINSEY,MP1,09/01/2006
BLACKP00,BRIAN,JOHNSON,MP1,09/01/2006
SORTOF00,NATANIA,JANSZ,MP1,09/01/2006
BMJPUB00,SALLY,CARTER,MP1,09/01/2006
EQUPUB00,VALERIE,HALL,MP1,09/01/2006
PICPRE00,CLEMENTINE,KOENIG,MP1,09/01/2006
MICOMA00,JUDITH,PALMER,MP1,09/01/2006
IMPLTD00,RICHARD,SHINER,MP1,09/01/2006
HODWAY00,KIRSTY,HAMILTON,MP1,09/01/2006
HARCOL00,EMILY,PITCHER,MP1,09/01/2006
ARCTUR00,ROBERTA,BAILEY,MP1,09/01/2006
MCGRAW01,MARIA,DECAMBRA,MP1,09/01/2006
USBPUB01,KATE,FEARN,MP1,09/01/2006
PHILIP00,CHRISTIAN,HUMPHRIES,MP1,09/01/2006
OCTPUS00,CHRISTINE,JUNEMANN,MP1,09/01/2006
GRALEA00,MIKE,KAY,MP1,09/01/2006
HEINEM00,EMMA,LYNCH,MP1,09/01/2006
BRIBOO00,LYNDA,MARSHALL,MP1,09/01/2006
OXUNPR00,PIPPA,MCNEE,MP1,09/01/2006
BLASCI01,CEE,PIKE,MP1,09/01/2006
ARCPRE00,ALISON,YATES,MP1,09/01/2006
TRANSW00,GAVIN,MORRIS,MP1,09/01/2006
GALHEA00,PAULA,DA SILVA,MP1,09/01/2006
PHASE200,CHRISTINE,MULROONEY,MP1,09/01/2006
=======================================
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
