Here's the whole shootin' match...
#!/usr/local/bin/perl -wT
# ----------------------------------------------------------------------
my $debug = 0;
my @database_dirs =
(
"/home/state/dof/fire/",
"/home/state/dof/fire/"
);
my @template_dirs =
(
"/home/state/dof/fire/",
"/home/state/dof/fire/sit-rep-daily.shtml"
);
# ----------------------------------------------------------------------
use File::Basename;
use strict;
my $is_cgi = ! @ARGV;
$is_cgi = 1;
my $data; # Data file, relative to @database_dirs
my $template; # Template, relative to @template_dirs
my $from; # First record number, starting at 1
my $count; # Number of records to display, 0 == all
my $match; # Regular expression
my $mcol; # Match columns, starting from 1
if ($is_cgi) {
use CGI qw(param header);
use CGI::Carp qw(fatalsToBrowser);
###########################################################################
# Get parameters
###########################################################################
my $d = param('data');
my $t = param('template');
$from = param('from') || 2;
$count = param('count') || 1;
$match = param('match');
$mcol = param('mcol') || 1;
defined $d or usage("Input data file was not given");
defined $t or usage("HTML template file was not given");
$d =~ m|^/*(\w[\w\.\-]*)$| or usage("Not a valid file name $d");
$d = $1;
$t =~ m|^/*(\w[\w\.\-]*)$| or usage("Not a valid file name $t");
$t = $1;
foreach my $database_dir (@database_dirs) {
if (-f "$database_dir/$d") {
$data = "$database_dir/$d";
last;
}
}
foreach my $template_dir (@template_dirs) {
if (-f "$template_dir/$t") {
$template = "$template_dir/$t";
last;
}
}
defined $data or usage("File not found $data");
defined $template or usage("File not found $template");
$ENV{'PATH_INFO'} and usage("This new script is configured differently");
print header();
} else {
my $outfile = pop @ARGV;
$outfile or usage("You have to specify an out file");
$outfile =~ /^(\w[\w\.\-]*)$/ or usage("Out file not defined.");
$outfile = $1;
my %param = map {(split('=', $_, 2))} @ARGV;
map {print "==== option $_ = $param{$_}<br>\n"} keys %param if $debug;
# We get the parameters
$data = $param{'data'};
$template = $param{'template'};
$from = $param{'from'} || 2;
$count = $param{'count'} || 1;
$match = $param{'match'};
$mcol = $param{'mcol'} || 1;
defined $data or usage("CSV file not defined.");
defined $template or usage("HTML template not defined.");
open(STDOUT,">$outfile")
or usage("Can't redirect STDOUT to file $outfile - $!");
}
$from =~ /^\d+$/ or usage("'from' has to be a number");
$count =~ /^\d+$/ or usage("'count' has to be a number");
if (defined $match) {
$match =~ s/^\s+//;
$match =~ s/\s+$//;
$mcol =~ /^\d+$/ or usage("Column has has to be a number: $mcol");
}
###########################################################################
# Open HTML Template and Execute it
###########################################################################
open(DB, $data)
or usage("Can't open file \"$data\": $!");
my @records;
my $i = 1;
while (<DB>) {
my $record = parse_line($_);
if (defined $match and $match) {
print "MATCH $record->{$mcol} $mcol $match<br>\n" if $debug;
next unless exists $record->{$mcol};
next unless $record->{$mcol} =~ m{$match}oi;
}
print "ITERATE i = $i, from = $from, count = $count<br>\n" if $debug;
next if $i++ < $from;
last if $count and ($i > ($from + $count));
push(@records, $record);
}
close DB;
open(TEMPLATE, $template)
or usage("Can't open file \"$template\": $!");
do_page(join('', <TEMPLATE>));
close TEMPLATE;
close(STDOUT) unless $is_cgi;
###########################################################################
# Substitution
###########################################################################
sub do_page {
my $page = shift;
foreach (split(m|(<repeat>.*?</repeat>)|si, $page)) {
if (m|<repeat>(.*?)</repeat>|si) {
print "**** start repeat<br>\n" if $debug;
do_repeat($1);
print "**** end repeat<br>\n" if $debug;
} else {
print "**** start text<br>\n" if $debug;
print;
print "**** end text<br>\n" if $debug;
}
}
}
sub do_repeat {
my $repeat = shift;
my $text = '';
my @parts = split(/<next>/i, $repeat);
while (@records) {
print "** start record<br>\n" if $debug;
foreach my $p (@parts) {
last unless @records; # FIXME: use or not????
my $record = shift @records;
my $part = $p; # Copy so can change
$part =~ s/\$arg([0-9]{1,3})/$record->{$1} || ''/ge;
print "* start part<br>\n" if $debug;
print $part;
print "* end part<br>\n" if $debug;
}
print "** end record<br>\n" if $debug;
}
}
###########################################################################
# Parse one line
###########################################################################
sub parse_line {
my $line = shift;
chomp($line);
print "LINE: $line<br>\n" if $debug;
my %record;
my $entry;
my $i = 1; # First index
while ($line) {
if ($line =~
s {
^\"
((?:[^\"]|\"\")*)
\"
(?:,|$)
} {}x) {
$entry = $1;
} elsif ($line =~
s {
^
(.*?)
(?:,|$)
} {}x) {
$entry = $1;
} else {
die "Can't parse the line $line";
}
$entry =~ s/\"\"/\"/g;
$record{$i++} = $entry;
}
return \%record;
}
Thanks again....
James Edward Gray II <[EMAIL PROTECTED]> wrote:On Feb 5, 2004, at 11:56 AM, Gregg
O'Donnell wrote:
> Good follow-up, and here's a snippet:
Just FYI, there are multiple CSV parsing modules on the CPAN. I use
Text::CSV_XS personally.
> sub parse_line {
> my $line = shift;
> chomp($line);
> print "LINE: $line
\n" if $debug;
> my %record;
> my $entry;
> my $i = 1; # First index
> while ($line) {
> if ($line =~
> s {
> ^\"
> ((?:[^\"]|\"\")*)
> \"
> (?:,|$)
> } {}x) {
" is not a special character, in a regular expression, so save your
eyes and drop the \s. ;)
> $entry = $1;
> } elsif ($line =~
> s {
> ^
> (.*?)
> (?:,|$)
> } {}x) {
> $entry = $1;
> } else {
> die "Can't parse the line $line";
> }
> $entry =~ s/\"\"/\"/g;
This line is out of place, isn't it? It's only needed if the field was
quoted and should be moved inside the if.
> $record{$i++} = $entry;
You can eliminate the need for this line and the entry variable, if you
store them when you find them.
Also, you're using a hash when you should be using an array.
Numerically indexed data belongs in an array.
> }
> return \%record;
> }
Unfortunately, this sub doesn't really tell us about your problem. I
see nothing wrong here. Does %record contain what you think it does on
exit? You might try printing it to find out.
I suspect the original problem is in your output code somewhere.
James
---------------------------------
Do you Yahoo!?
Yahoo! Finance: Get your refund fast by filing online
