=?iso-8859-1?Q?=A1=A1=A1SOCORRO=21=21=21?=

Mon, 23 Feb 1998 18:11:33 +0100

¡Hola a todos!
Tengo un problemilla que me está trayendo de cabeza. Seguro que es una
chorrada, pero soy incapaz de resolverlo. Os cuento:
Quiero probar un script al que accedo al introducir datos en un
formulario, y me sale el siguiente mensaje en el navegador:

HTTP/1.0 501 No soportado

El código del formulario es:

<form ACTION="/midirectorio/cgi-bin/everycht.pl" METHOD="POST">
  <input type="hidden" name="message" value="¡Acabo de entrar!  ¡Hola a
to'quisqui!"><input
  type="hidden" name="room" value="messages"><p>Escribe tu <b>nombre</b>
aquí para entrar: <input
  type="text" name="username" size="20"> <input type="submit"
value="Entrar"></p>
</form>

El código del script es:

#!c:/perl/bin/perl.exe
$filepath='c:/webshare/wwwroot/midirectorio/mensajes/';
$filext='.html';
$iecompatible=0;
print "Content-type: text/html\nPragma: no-cache\n\n";
&get_form_data;
$formdata{'room'} =~ s/\W//g;
unless (open(HTMLOLD, "$filepath$formdata{'room'}$filext"))
{
	die 'The following room does not exist on this server: ';
}
@lines=<HTMLOLD>;
close(HTMLOLD);
$now_string = localtime;
@thetime = split(/ +/,$now_string);
@theclock = split(/:/,$thetime[3]);
$ampm = 'am';
if ($theclock[0] > 11)
{ $ampm = 'pm'; }
if ($theclock[0] == 0)
{ $theclock[0] = 12; }
if ($theclock[0] > 12)
{ $theclock[0] -= 12; }
else
{ $theclock[0] += 0; }
print "<html><title></title><BODY BGCOLOR=\#000080 TEXT=\#FFFFFF>\n";
if ($formdata{'logoff'} eq '1')
{
	print "<CENTER>Thank you for using EveryChat
3.5\!</CENTER><BR><HR><FONT SIZE=-1>\n";
}
else
{
	print "<CENTER><TABLE CELLSPACING=0 CELLPADDING=0>\n<TR>\n<TD>\n";
	print "<nobr><FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">Your
message\:\n\<input name=username type=hidden
value=\"$formdata{'username'}\">\n";
	print "<input name=room type=hidden value=\"$formdata{'room'}\"\>\n";
	print "<input type=text name=message size=35>\n";
	print "<input type=submit value=\"Post This\">";
	print "</form></nobr>\n</TD>\n<TD>\n";
	print "<nobr><FORM ACTION=\"$ENV{'SCRIPT_NAME'}\"
METHOD=\"POST\"><input name=username type=hidden
value=\"$formdata{'username'}\">\n";
	print "<input name=room type=hidden value=\"$formdata{'room'}\">\n";
	print "<input name=logoff type=hidden value=1>\n";
	print "<input type=hidden name=message value=\"Buh\-Bye\! I just logged
off\!\">\n";
	print "<input type=submit value=\"Logoff\">";
	print "</form></nobr>\n</TD>\n</TR>\n</TABLE></CENTER><BR><HR>\n";
	print "<FONT SIZE=\-2>Hit \"post\" without entering a message to
refresh the screen\.\.\.</FONT><FONT SIZE=-1>\n";
}
if ($formdata{'message'} ne "") {
	$newmessage = "\<P\>\<B\>$formdata{'username'}\</B\>
says\,\"$formdata{'message'}\" \($thetime[0]
$theclock[0]\:$theclock[1]$ampm\)\n";
	open (NEW, ">$filepath$formdata{'room'}$filext");
	print NEW '<HTML><HEAD><META HTTP-EQUIV="Refresh"
CONTENT="5"></HEAD><BODY BGCOLOR="#FFFFFF">';
	print NEW "\n";
	if ($iecompatible) {
		print NEW $newmessage;
		print $newmessage;
		for ($i = 1; $i < 15; $i++)
		{
		    print NEW "$lines[$i]";
		    print "$lines[$i]";
		}
		print NEW '<BR><FONT COLOR=#FFFFFF>EveryChat (c) 1997 Matt
Hahnfeld</FONT></BODY>';
	}
	else {
		for ($i = 2; $i < 16; $i++)
		{
		    print NEW "$lines[$i]";
		    print "$lines[$i]";
		}
		print NEW $newmessage;
		print $newmessage;
		print NEW '<BR><FONT COLOR=#FFFFFF><A NAME="END">EveryChat (c) 1997
Matt Hahnfeld</A></FONT></BODY>';
	}
	print NEW "\n";
	close(NEW);
}
else {
	for ($i = 1; $i < 16; $i++)
		{
		    print "$lines[$i]";
		}
}
print "</font></body></html>\n";
exit 0;
sub get_form_data {
	$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;  # html tag removal (remove these lines to
enable HTML tags in messages)
		$value =~ s/\>/\&gt\;/g;  # html tag removal (remove these lines to
enable HTML tags in messages)
		$value =~ s/\r//g;
		push (@data,$name);
		push (@data, $value);
	}
	%formdata=@data;
	%formdata;
}

Tengo Windows 95 y Perl 5, ¡y estoy desesperada! Lo he probado todo y
nada. ¿Algún alma caritativa podría decirme dónde estoy metiendo la
pata?
Si me podéis echar una mano con esto os estaré eternamente agradecida, y
además evitaréis que me tire por la ventana ;-D

Saludos,
Belén.