Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

Refrescar página automáticamente

¿Ya sabes lo que es una referencia? Has progresado, el nível básico es cosa del pasado y ahora estás listo para el siguiente nivel.
Publicar una respuesta

Refrescar página automáticamente

Notapor rafa » 2005-11-10 06:15 @302

Hola, tengo de nuevo un pequeño problema, tengo esta programación :

print NEW "#!/usr/bin/perl\n";
print NEW "print <<CABECERA;\n";
print NEW "<HTML><HEAD><META HTTP-EQUIV=\"Refresh\" CONTENT=\"$ChatRefresh;URL=http://perl.intranet.gc/perl/estadis/mensajes/centro/centro/general.htm\">\n";
print NEW '<META HTTP-EQUIV="Expires" CONTENT="Fri, Jun 12 1981 08:20:00 GMT">' . "\n";
print NEW '<META HTTP-EQUIV="Pragma" CONTENT="no-cache">' . "\n";
print NEW '<META HTTP-EQUIV="Cache-Control" CONTENT="no-cache">' . "\n";
print NEW "</HEAD><BODY OnContextMenu=\"return false\" link=\"#006200\">\n";

print "<HTML><HEAD><META HTTP-EQUIV=\"Refresh\" CONTENT=\"$ChatRefresh;URL=$chaturl/$formdata{'room'}\.htm\">\n";
print '<META HTTP-EQUIV="Expires" CONTENT="Fri, Jun 12 1981 08:20:00 GMT">' . "\n";
print '<META HTTP-EQUIV="Pragma" CONTENT="no-cache">' . "\n";
print '<META HTTP-EQUIV="Cache-Control" CONTENT="no-cache">' . "\n";
print "</HEAD><BODY OnContextMenu=\"return false\" link=\"#006200\">\n";

pero solo me refresca una vez, porque me falla, como veras manda los datos con print y luego los muestra.
Gracias anticipadas, un saludo.
rafa
Perlero nuevo
Perlero nuevo
 
Mensajes: 20
Registrado: 2004-05-14 05:04 @252
Arriba

Publicidad

Notapor explorer39 » 2005-11-10 07:04 @336

Código: Seleccionar todo
#!/usr/bin/perl

my $ChatRefresh = 5;

print <<"CABECERA";
<HTML><HEAD><META HTTP-EQUIV="Refresh" CONTENT="$ChatRefresh;URL=http://perl.intranet.gc/perl/estadis/mensajes/centro/centro/general.htm">
<META HTTP-EQUIV="Expires" CONTENT="Fri, Jun 12 1981 08:20:00 GMT">
<META HTTP-EQUIV="Pragma" CONTENT="no-cache">
<META HTTP-EQUIV="Cache-Control" CONTENT="no-cache">
</HEAD><BODY OnContextMenu="return false" link="#006200">
CABECERA
explorer39
 
Arriba

REFRESCAR PAGINA

Notapor rafa » 2005-11-10 08:28 @394

Perdon se me olvidaba poner al principio esto :

open (NEW, ">$chatpath/$formdata{'room'}\.htm");

tengo que poner el print NEW para mandarlo primero al fichero base que se llama general.htm (aunque interiormente es programacion PL)
Esto es un chat, mando primero al general.htm los datos con print NEW y estos se muerstran luego en la pagina, mas o menos creo que funciona asi.
Un gracias explorer39
Un saludo.
rafa
Perlero nuevo
Perlero nuevo
 
Mensajes: 20
Registrado: 2004-05-14 05:04 @252
Arriba

REFRESCAR PAGINA

Notapor rafa » 2005-11-10 08:32 @397

Bueno dejo aqui toda la programacion de la página :


#!/usr/bin/perl


$ip = $ENV{'REMOTE_ADDR'};
$_ = $ip;
@numeros = split(/\./);


$main_dir3 = '/var/www/perl/estadis/control/claves';


#########ESTO ES EL NOMBRE PROVINCIA Y Nº VECES QUE ENTRO

open(IN,"$main_dir3/online_provincias.txt");
while(<IN>){
@B = split (/;/);
if ($B[0] eq "$numeros[1]"){
$nombre = "$B[1]" . "-" . "Área Pública";
}
}
######AQUI TERMINA

#########EXTRAE SI ES DE RESTRINGIDA O PUBLICA

open(DATA,"$main_dir3/claves_control.txt");
while(<DATA>){
@clave = split (/;/);
my $numero = "$numeros[1].$numeros[2].$numeros[3]";
if ($clave[1] eq "$numero"){
$provincias = $clave[2];
last;
}else{
$provincias = $nombre;
}
}
#########AQUI TERMINA



$imagedir = '../../../../../graficas-perl/utiles';


$chatpath = '/var/www/perl/estadis/mensajes/centro/centro';
$chaturl = 'http://perl.intranet.gc/perl/estadis/mensajes/centro/centro';

$ChatRefresh = 10;
$ChatMessageTime = 3600;

$chatLogging = '0';
$logFileName = 'historico.htm';

@badwords = ("follar", "sexo", "puta", "puton", "huevos", "polla", "cipote", "cornudo", "tortillera", "pedorra", "pedorro", "caga", "cagado", "hijoputa", "cabron", "maricon", "mariquita", "gay", "pene", "lesbiana", "homosexual", "porno", "joder", "coño", "cuernos", "jodiendo", "f`?.?u`?.?c`?.?k"); #PROHIBE PALABRAS

$exclude_channel = 'adult';


print "Content-type: text/html\nPragma: no-cache\n\n";

&get_form_data;

$formdata{'room'} =~ s/\W//g;
$formdata{'room'} = lc($formdata{'room'});

&lock($chatpath . '/' . $formdata{'room'} . '.lck');

if (!(-e "$chatpath/$formdata{'room'}\.htm")) {
open(CREATE, ">$chatpath/$formdata{'room'}\.htm");
close(CREATE);
}



@fechas = localtime (time());
$ar = 1900 + @fechas[5];
$mes = @fechas[4] + 1;
$dia = @fechas[3];
$fechadia = @fechas[3]. "" .$mes. "" .$ar; # si no hay nada entre las comillas,junta los datos


open(HTMLOLD, "$chatpath/$formdata{'room'}\.htm") ||
&myerror("Unable to open room: $formdata{'room'}");
@lines=<HTMLOLD>;
close(HTMLOLD);

my $thetime = time;

$newmessage = '';
if (($formdata{'cname'} ne '') && ($formdata{'message'} ne '')){
# remove all badwords
$exclude_channel = lc($exclude_channel);
if ($exclude_channel ne $formdata{'room'}) {
if (@badwords > 0) {
foreach $curse (@badwords) {
$formdata{'message'} =~ s/$curse/\<font color=red\>\%\&\#\%\<\/font\>/ig;
$formdata{'cname'} =~ s/$curse/\<font color=red\>\%\&\#\%\<\/font\>/ig;
}
}
}
# format the message
$ColoredName = $formdata{'cname'};
$ColoredMessage = $formdata{'message'};

# replace smilely faces
$ColoredMessage =~ s/\:\)/\<img src=\"$imagedir\/smile1.gif\" width=\"16\" height=\"12\" border=\"0\"\>/g;
$ColoredMessage =~ s/\:\(/\<img src=\"$imagedir\/smile2.gif\" width=\"16\" height=\"12\" border=\"0\"\>/g;
$ColoredMessage =~ s/\;\)/\<img src=\"$imagedir\/smile3.gif\" width=\"16\" height=\"12\" border=\"0\"\>/g;
$ColoredMessage =~ s/\;;\)/\<img src=\"$imagedir\/atras.gif\" width=\"16\" height=\"12\" border=\"0\"\>/g;
# check for me action
if ($ColoredMessage =~ s/^\.me//i) {
$ColoredName = &Make_Color('`1' . $ColoredName);
$ColoredMessage = &Make_Color('`1' . '&nbsp;&nbsp;' . '<B>' . "@fechas[2]:@fechas[1]" . '&nbsp;&nbsp;&nbsp;' . $ColoredMessage . '</B>');
} else {
$ColoredName = &Make_Color('`2' . $ColoredName . '&nbsp;&nbsp;');
$ColoredMessage = &Make_Color("@fechas[2]:@fechas[1]" . '&nbsp;&nbsp;&nbsp;' . $ColoredMessage);
}

$newmessage = "<FONT SIZE=\"-1\" color=\"#006200\"><B>$ColoredName</B></FONT> <FONT SIZE=\"3\" color=\"#000000\" face=\"Arial\"> $ColoredMessage<!--$thetime//--></FONT><br>\n";
}

open (NEW, ">$chatpath/$formdata{'room'}\.htm");
print NEW "#!/usr/bin/perl\n";
print NEW "print <<CABECERA;\n";
print NEW "<HTML><HEAD><META HTTP-EQUIV=\"Refresh\" CONTENT=\"$ChatRefresh;URL=http://perl.intranet.gc/perl/estadis/mensajes/centro/centro/general.htm\">\n";
print NEW '<META HTTP-EQUIV="Expires" CONTENT="Fri, Jun 12 1981 08:20:00 GMT">' . "\n";
print NEW '<META HTTP-EQUIV="Pragma" CONTENT="no-cache">' . "\n";
print NEW '<META HTTP-EQUIV="Cache-Control" CONTENT="no-cache">' . "\n";
print NEW "</HEAD><BODY OnContextMenu=\"return false\" link=\"#006200\">\n";
print "<HTML><HEAD><META HTTP-EQUIV=\"Refresh\" CONTENT=\"$ChatRefresh;URL=$chaturl/$formdata{'room'}\.htm\">\n";
print '<META HTTP-EQUIV="Expires" CONTENT="Fri, Jun 12 1981 08:20:00 GMT">' . "\n";
print '<META HTTP-EQUIV="Pragma" CONTENT="no-cache">' . "\n";
print '<META HTTP-EQUIV="Cache-Control" CONTENT="no-cache">' . "\n";
print "</HEAD><BODY link=\"#006200\">\n";
if ($newmessage ne '') {
print NEW $newmessage;
print $newmessage;
if ($chatLogging) {
my $now_string = gmtime;
if (open(CHATLOG, ">>$chatpath/$logFileName")) {
print CHATLOG '<small>' . $now_string . '-' . $formdata{'room'} . '-</small>' . $newmessage;
close(CHATLOG);
}
}
}

for ($i = 1; $i < @lines; $i++)
{
$lines[$i] =~ m/<!--(\d*)\/\/-->/;
if ((time - $1) <= $ChatMessageTime)
{
if ($lines[$i] ne "</BODY></HTML>\n") {
print NEW "$lines[$i]";
print "$lines[$i]";
}
}
}

print NEW "</BODY></HTML>\n";
print NEW "CABECERA\n";
print "</BODY></HTML>\n";
close(NEW);

&unlock($chatpath . '/' . $formdata{'room'} . '.lck');
exit;

sub get_form_data {
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
@pairs = split(/&/,$ENV{'QUERY_STRING'});
}
else
{
$buffer = "";
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/,$buffer);
}

foreach $pair (@pairs)
{
@a = split(/=/,$pair);
$name=$a[0];
$value=$a[1];
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/~!/ ~!/g;
$value =~ s/\+/ /g;
$value =~ s/\</\&lt\;/g; # remove to enable html tags in messages.
$value =~ s/\>/\&gt\;/g; # remove to enable html tags in messages.
$value =~ s/\r//g;
push (@data,$name);
push (@data, $value);
}
%formdata=@data;
%formdata;
}

sub myerror {
my $msg = shift;
&unlock($chatpath . '/' . $formdata{'room'} . '.lck');
print $msg;
exit;
}

sub Make_Color {
my $st = shift;
my $result = '';
my $colors = 0;
my $i;
my $ch;

for ($i=0; $i < length($st); $i++) {
if (substr($st,$i,1) eq '`') {
$i++;
if ($i > length($st)) { next; }
$ch = substr($st,$i,1);
if ($ch eq '1') {$result .= '<font color="#0000FF">'; $colors++;}
elsif ($ch eq '2') {$result .= '<font color="#006200">'; $colors++;}
elsif ($ch eq '3') {$result .= '<font color="#FFFF00">'; $colors++;}
elsif ($ch eq '4') {$result .= '<font color="#FF0000">'; $colors++;}
elsif ($ch eq '5') {$result .= '<font color="#6600FF">'; $colors++;}
elsif ($ch eq '6') {$result .= '<font color="#9900FF">'; $colors++;}
elsif ($ch eq '7') {$result .= '<font color="#007100">'; $colors++;}
elsif ($ch eq '8') {$result .= '<font color="#0000C0">'; $colors++;}
elsif ($ch eq '9') {$result .= '<font color="#000000">'; $colors++;}
elsif ($ch eq '0') {$result .= '<font color="#996600">'; $colors++;}
elsif ($ch eq '!') {$result .= '<font color="#400060">'; $colors++;}
elsif ($ch eq '@') {$result .= '<font color="#20A0FF">'; $colors++;}
elsif ($ch eq '#') {$result .= '<font color="#808080">'; $colors++;}
elsif ($ch eq 'A') {$result .= '<font color="#006600">'; $colors++;}
elsif ($ch eq '$') {$result .= '<font color="#AAAA00">'; $colors++;}
elsif ($ch eq '%') {$result .= '<font color="#FFFFFF">'; $colors++;}
} else {
$result .= substr($st,$i,1);
}
}

while ($colors--) { $result .= '</font>'; }

return ($result);
}

sub lock
{
$mylockfile = shift;
my $endtime = time + 7;
if (-e $mylockfile) {
open (LOCKFILE, $mylockfile);
my $temp = <LOCKFILE>;
close (LOCKFILE);
if ($temp < time) {
unlink ($mylockfile);
}
}
while (-e $mylockfile && time < $endtime) {
sleep(1);
}
if (-e $mylockfile) {
&error("Can't obtain file lock for $mylockfile");
} else {
open (LOCKFILE, ">$mylockfile") or &error ("Can't obtain file lock for $mylockfile");
print LOCKFILE (time + 10);
close(LOCKFILE);
}
}

sub unlock
{
$mylockfile = shift;
# close (LOCKFILE);
unlink ($mylockfile);
}

sub error
{
my $msg = shift;
print "<html><head><title>File Lock Error</title></head><body>\n";
print '<p><a href="javascript:window.location.reload(1);">Click Here</a> to try again.</p>';
print "\n<p>$msg</p>\n";
print '<p>This may be caused by an incorrectly set variable.</p>';
print '<p>The $chatpath variable must be the path, not the URL to the chat directory.</p>';
print '<p>Also make sure the chat directory exists and is chmod 777</p>';
print '</body></html>';
exit;
}
rafa
Perlero nuevo
Perlero nuevo
 
Mensajes: 20
Registrado: 2004-05-14 05:04 @252
Arriba

REFRESCAR PAGINA

Notapor rafa » 2005-11-11 06:05 @295

El problema lo tengo aqui :

print NEW "<HTML><HEAD><META HTTP-EQUIV=\"Refresh\" CONTENT=\"$ChatRefresh\">\n";


Esto no lo imprime en la página, pero si está en el fichero base general.htm, y si lo pongo por separado cada cosa es decir el <HTML>,
<HEAD> y <META.., entonces si refresca pero da problemas con el usuario, a veces repite el nombre varias veces.
rafa
Perlero nuevo
Perlero nuevo
 
Mensajes: 20
Registrado: 2004-05-14 05:04 @252
Arriba
Publicar una respuesta

Volver a Intermedio

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 0 invitados

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management