Here's the script. I only hide the HTML portions.

I'm using:
Apache/2.0.44 (Unix) mod_perl/1.99_08 Perl/v5.8.0 PHP/4.3.1

----------------------------------------------------------


#!/usr/bin/perl -w

$buffer = $ENV{'QUERY_STRING'};

@pairs = split(/&/, $buffer);

foreach $pair (@pairs) {
    ($name, $value) = split(/=/, $pair,2);
    $value =~ tr/+/ /;
    $value =~ s/%(..)/pack("C", hex($1))/eg;
    $FORM{$name} = $value;
}

#verify that the field was sent
if (defined($FORM{'referencia'})) {
    $referencia = $FORM{'referencia'}
} else {
    print "Location: SOME URL HERE\n\n";
    exit(1);
}


# ---------------
# set STDOUT HOT
# ---------------
{
   my $ofh = select STDOUT;
   $|++;
   select $ofh;
}


print "Content-Type: text/html\n\n";

#---------------------
# read REFERENCIA.TXT
#---------------------
$arq_produto = '/var/www/default/clientes/gecele/db/'.$referencia.'.txt';


    open(FILE,"$arq_produto") || &error('ocorreu um erro ao ler o arquivo');

    $_ = <FILE>; # set the name of the obs file
    chop($_) if $_ =~ /\n$/;
    $arq_obs = '/var/www/default/clientes/gecele/db/'.$_;

    $_ = <FILE>; # set the name of the image path
    chop($_) if $_ =~ /\n$/;
    $path_imagem = $_;

    $_ = <FILE>; # set colors file
    chop($_) if $_ =~ /\n$/;
    $arq_cores = '/var/www/default/clientes/gecele/db/'.$_;

# continue until EOF

    while ($_ = <FILE>) {
        chop($_) if $_ =~ /\n$/;
        ($tmp_referencia,$tmp_tamanho) = split(/;/,$_,2);
        $referencia_tamanho{$tmp_referencia} = $tmp_tamanho;
    }

close(FILE);



#-------------------
# OBS file reading
#-------------------

    open(FILE,"$arq_obs") || &error('ocorreu um erro ao ler o arquivo');

    $_ = <FILE>;
    chop($_) if $_ =~ /\n$/;
    $szObs = $_;

    close(FILE);

print <<'HTML_TAGS';
...
...
...
HTML_TAGS

print '<td align="center"><img src="SOME URL'.$path_imagem.'" width="231"
height="200"></td>';

print <<'HTML_TAGS';
...
...
...
HTML_TAGS


$fCor = 0;

foreach $temp (sort(keys %referencia_tamanho)) {
    if ($fCor == 0) {
       print '<tr>',"\n";
       $fCor = 1;
    }
    else {
       print '<tr bgcolor="#f0f0ef">',"\n";
       $fCor = 0;
    }

    print '<td width="50%" valign="middle" class="texto2"> <input
type="checkbox" name="ref_',$temp,'" align="absmiddle">',"\n";

    $tmp_string = $temp;
    $tmp_string =~ s/_/\//g;
    $tmp_string = ucfirst($tmp_string);

    print $tmp_string.'</td>'."\n";
    print '<td width="1%" bgcolor="CECECD"></td>'."\n";

    $tmp_string_tamanho = $referencia_tamanho{$temp};

    if ($tmp_string_tamanho eq 'null') {
       $tmp_string_tamanho = '';
    }

    print '<td width="50%" align="center" valign="middle"
class="texto2">'.$tmp_string_tamanho.'</td>',"\n";
    print "</tr>\n";
}


print <<'HTML_TAGS';
...
...
...
HTML_TAGS

print $szObs,'</td>',"\n";

print <<'HTML_TAGS';
...
...
...
HTML_TAGS

exit;


sub error {
  $error = shift(@_);
  print "Erro: $error";
  exit(1);
}

----------------------------------------------------------------------



----- Original Message -----
From: "Ged Haywood" <[EMAIL PROTECTED]>
To: "Giovani M. Zaffari" <[EMAIL PROTECTED]>
Cc: <[EMAIL PROTECTED]>
Sent: Saturday, November 22, 2003 7:51 AM
Subject: Re: Giovani - Problemas with RELOAD in MS Explorer


> Hi there,
>
> On Fri, 21 Nov 2003, Giovani M. Zaffari wrote:
>
> > Someone had a problem with the Reload / Refresh page using the mod_perl?
>
> No.
>
> > I have a script that runs ok only the first time (or when
> > it's not in the cache), but the second time some images disappear
> > and the browser stay in a loop trying do download them indefinitly.
>
> You need to look at your script.  If you can reduce it to a few lines
> which demonstrate your problem, feel free to post it here.  You should
> also post a *lot* more information, such as what operating system you
> are using, what versions of Apache and mod_perl etc.  Please read the
> documentation on the mod_perl site first.
>
> 73,
> Ged.
>
>
>
> --
> Reporting bugs: http://perl.apache.org/bugs/
> Mail list info: http://perl.apache.org/maillist/modperl.html


-- 
Reporting bugs: http://perl.apache.org/bugs/
Mail list info: http://perl.apache.org/maillist/modperl.html

Reply via email to