in reply to Problem with CGI script not working (regex at fault)

I could speculate all day but if you add this block of code to the begining of your script then Perl will tell you exactly what the problem is in the browser window rather than give you a 500 internal server error. Perhaps you might like to add this, then post the result if you can't answer the problem yourself with the info you will get? 

# ensure all fatals go to browser during debugging and setup
# *don't* uncomment these lines on production code for security
BEGIN {
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');
}

[download]

As an aside the /i modifier makes the regex case insensitive which is what you are doing in a fairly obscure way with this bit: 

/^<(?:[Tt][Rr])...../

# it would be much easier to read if you had
/^<(?:TR).........../i

[download]

Also I really doubt you need/want this at the end of your regex: 

(<.*)?

[download]

I guess the reason for suggesting using a module written for the task is that it is likely to be more reliable and robust than a regex solution.

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

Replies are listed 'Best First'.
Re: Re: Problem with CGI script not working (regex at fault)
by deryni (Beadle) on Jul 30, 2001 at 01:51 UTC
    First off it's quite a "Duh!" moment when someone points out something you just hadn't thought of but really should have, (i.e. the /i switch), thanks. Let's hope I remember it in the future.

    I put in the BEGIN block you suggested and got nothing, absolutely nothing printed to the browser.

    As for the (<.*)? at the end, I need that there because they're are special circumstances where there is a complimentary bit of information stuck on the end of the line, and I put that in to slurp it up.

    Thanks for the help and advice so far, now if I could only figure out what the problem was.

       -Etan
[reply]

      If nothing prints to the browser then you have a problem with your script that has nothing to do with your regex. The BEGIN block prints a valid header (as every CGI script must). It does not stop your script from printing a valid header, so *at the very least* you should get some header info in the browser window - this is the header info you script would output without the BEGIN block. If you do not your script is not printing a valid header (nor anything else if you do not see anything in the browser window). You will need to post a link to the full script or post it here as the problem is not the regex as you suggest.

      cheers

      tachyon

      s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

[reply]
        Here is the loop that is reading from the file, as requested. The whole script is a couple hundred lines, I can post it if you think it's necessary, but I think the problem is here. I'm using strict and warnings, just so you know. 
        my $HTML = $query->param(-name=>"file");

print $query->header;
print $query->start_html("Class Schedule");

while (<$HTML>) {
#    if (/SEE SCHEDULE OF CLASSES/) {
#       next;
#    }
    if (/^<(?:TR).*?>(\d{5}).*?>(\d{2}).*?>(\d{3}).*?>(\d{3}).*?>(\d{2
+}).*?>(?:[&\w]).*?>(\w+(?:(?:[\s\w|&]+)?)*).*?>\s(\d).*?>(\w*?\d(?:[,
+\d\*]?)*)((?:[\w\d,]?)+).*?>(\w(?:(?:[\w\d-])?)*).*?<\/TR>(<.*)?/i) {
        push(@classid, $1);
        my $rec = join("", split(/,/, $9));
        my $h_fix = join("", split(/,/, $8));
        $rec =~ tr/H/h/;
        $h_fix =~ tr/H/h/;
        push(@classes, $h_fix);
        push(@class, parse($h_fix));
        push(@location, $10);
        my @mi2 = ($2, $3, $4, $5);
        push(my @misc_info, \@mi2);
        push(@credits, $7);
        my $short_name = $6;
        $short_name =~ s/&/ AND /;
        push(@classname, $short_name);
        if ($h_fix =~ /\*$/) {
            push (@starperiod, "*");
        }
        else {
            push(@starperiod, "");
        }
        if ($9) {
            push(@classes, $rec);
            push(@class, parse($rec));
            push(@classid, $1);
            push(@location, $10);
            push(@misc_info, \@mi2);
            push(@credits, $7);
            push(@classname, $short_name);
            if ($rec =~ /\*$/) {
               push (@starperiod, "*");
            }
            else {
                push(@starperiod, "");
            }
        }
        my @erec;
        if ($11) {
            my @temprec;
            @erec = $11 =~ />(.*?)</g;
            for (my $z = 0; $z < @erec; $z++) {
                my $rectemp;
                if ($erec[$z] =~ /^&/) {
                }
                else {
                    if ($erec[$z] =~ /\*$/) {
                        push (@starperiod, "*");
                        chop($erec[$z]);
                        $rectemp = $erec[$z];
                    }
                    else {
                        $rectemp = $erec[$z];
                    }
                    push(@temprec, $rectemp);
                }
            }
            my $temprec_fix = $temprec[10];
            $temprec_fix =~ tr/H/h/;
            push(@classid, $classid[-1]);
            push(@classes, $temprec_fix);
            push(@class, parse($temprec_fix));
            push(@location, $temprec[14]);
            push(@misc_info, \@mi2);
            push(@credits, $credits[-1]);
            push(@classname, $short_name);
        }
    }
}
close ($HTML);

        [download]
        The comments at the top are my workaround, it allowed the script to simply ignore the offending line and continue.
        Have fun

           -Etan
[reply]
[d/l]

In Section Seekers of Perl Wisdom