Article View: es.comp.os.linux.programacion
Article #16788Re: Ayuda del algun guru del Python ese o me paso al Perl :)
From: batsman batsman
Date: Wed, 22 Mar 2000 00:00
Date: Wed, 22 Mar 2000 00:00
170 lines
6456 bytes
6456 bytes
-----BEGIN PGP SIGNED MESSAGE-----
He decido enviar mi script en perl. Es un cgi, listo para ser llamado con un
form. Que conste que soy nuevo en perl y en desarrollo web en general (este
es mi primer script que hace algo �til, m�s o menos)
#!/usr/bin/perl -I/home/groups/asnews/lib/perl -I/home/groups/asnews/lib/perl/i
386-linux
# Copyright (c) 2000 batsman <batsman at geocities dot com>
# bla bla GPL bla bla
# es un cgi listo para ser usado desde un form
# - acepta mensajes de cualquier tama�o, los divide en paquetes y los env�a
# uno a uno, en orden, con control de errores
# - en teor�a no falla nunca (tm)
# el c�digo es feo, pero rulaba, ahora ya no va porque los de terra han
# a�adido dos cookies en su p�gina de env�o, pero es *casi* funcional
# por favor, que alguien arregle el c�digo :-) y me env�e una copia
# Hay que trabajarse dos nuevos cookies, TERRA_EMC_HORA y TERRA_EMC_MINUTO .
use CGI;
use Text::Wrap qw(wrap $columns);
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
local $debug = 1;
sub ajustar_fecha()
{
##my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @_;
## 0 1 2 3 4 5 6 7 8
$_[5] = $_[5]+1900;
$_[4] = $_[4]+1;
$_[4] = "0" . "$_[4]" if ($_[4]<10);
$_[3] = "0" . "$_[3]" if ($_[3]<10);
$_[2] = "0" . "$_[2]" if ($_[2]<10);
$_[1] = "0" . "$_[1]" if ($_[1]<10);
$_[0] = "0" . "$_[0]" if ($_[0]<10);
}
sub enviar_mensaje
{
my ($linea, $telefono,$repeat) = @_;
my $remote;
if ($repeat == 0) {
print "Error al enviar el mensaje: $linea<br>" if ($debug);
return;
}
my $ua = new LWP::UserAgent;
$ua->agent("Mozilla/5.0 " . $ua->agent);
# Create a request
my $seconds = time();
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($seconds);
&ajustar_fecha ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
#my $fecha = "{ts '$year-$mon-$mday $hour:$min:$sec'}";
my $req = POST 'http://www.terra.es/sms/envio.cfm', [ telefono => $telefono,
fecha => "CHANGEME",
mensaje => $linea];
my $cfecha = "%7Bts+%27$year%2D$mon%2D$mday+$hour%3A$min%3A$sec%27%7C";
$req->header ( Cookie => "TERRASMS_MINUTO=$cfecha; TERRASMS_HORA=$cfecha"
. "1",
Referer => "http://www.terra.es/sms/" );
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($seconds+240);
&ajustar_fecha ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
$cfecha = "%7Bts+%27$year%2D$mon%2D$mday+$hour%3A$min%3A$sec%27%7D";
${$req->content_ref} =~ s/CHANGEME/$cfecha/g;
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
# Check the outcome of the response
if ($res->content =~ /correctamente/) {
print "Mensaje enviado correctamente<br>" if ($debug);
return 1;
} elsif ($repeat > 1) {
print "Error al enviar mensaje. Reintentando<br>" if ($debug);
my $i;
for ($i=0; $i<3; $i++) {
return 1 if (&enviar_mensaje($linea,$telefono,1) == 1);
print "Reintentando env�o<br>" if ($debug);
}
sleep(1);
return &enviar_mensaje($linea,$telefono,$repeat-1);
}
print ( "Error al enviar el mensaje: $linea <br>" ) if ($debug);
return 0;
}
$query = new CGI;
my $telefono = $query->param('telefono');
my $mensaje = $query->param('mensaje');
print "Content-Type: text/html\n\n";
$columns = 100;
my $linea = wrap ("","",$mensaje);
my @lineas = split(/\n/,$linea);
my $numlineas = @lineas;
$| = 1; ## turn auto-flush on
print "<html><head><title>Env�o de mensaje a m�vil</title></head>";
print "<body>";
print "<h3>Telefono</h3> $telefono" if ($debug);
print "<h3>Mensaje</h3> $mensaje" if ($debug);
print "<h1>Mensaje enviado</h1>";
print "El mensaje ha sido fragmentado en $numlineas paquetes."
if ($numlineas > 1);
print "<h1>Mensaje enviado</h1>El mensaje no ha sido fragmentado."
if ($numlineas == 1);
print "<hr>";
sleep(1);
if (!$debug) {
print "</body></html>";
close(STDOUT);
};
sub espera
{
my $tiempo=5;
print "Esperando $tiempo segundos<br>" if ($debug);
sleep($tiempo);
}
for ($i=1; $i<$numlineas+1; $i++) {
&espera() if ($i>1);
&enviar_mensaje("$lineas[$i-1]\n$i/$numlineas\n(c) 2000 MFP",$telefono,10);
}
if ($debug) {
print "<hr>";
print "</body></html>";
close(STDOUT);
};
- --
_ _
| |__ __ _| |_ ___ _ __ ___ __ _ _ __
| '_ \ / _` | __/ __| '_ ` _ \ / _` | '_ \
| |_) | (_| | |_\__ \ | | | | | (_| | | | |
|_.__/ \__,_|\__|___/_| |_| |_|\__,_|_| |_|
________________________________________________________________
|Visit | http://www.geocities.com/SiliconValley/Vista/2075 |
|Linux | http://www.geocities.com/SiliconValley/Vista/4289 |
----------------------------------------------------------------
Real email: batsman dot geo at yahoo dot com
-----BEGIN PGP SIGNATURE-----
Version: 2.6.3ia
Charset: noconv
Comment: Public key via email: send mail with Subject: [PGPKEY]
iQEVAwUBONlDf70Y27yr0iefAQG42QgAn4i4rEGTTqnkWFU7y7UotKHTTmqKFIJt
OqCKrit2Q397cn2dAVGfMkGUIwWJXptiOMCH1TttIstov8I92LKond49rsGzrmD0
3BbvxSOMkrGuFkKzncBPY7PS7L+3fauMn0ECnT7JLwN441Idt3R1CLxP17ySmsw1
Cjz3L7yRRk+i9I/UkYdhr1AoQeCCsDPavFVpQWA+kynJQW+R07d4R7E7/YowP7BA
4xd5BdO7DVUMY0hbWDQ3rVQr3GTcxFvAOu14mRr7+RtIc0hbc4t0OeFbKvXO7cRl
8Dqn9a6nmBmaW8sRG8FUZObjdwn1e26X7NR+Mb7ou1HgmzC8M9Et/A==
=JncI
-----END PGP SIGNATURE-----
Technical Details
Message-ID:
<52gbb8.1h1.ln@simpsons4ever>Path:
arc1-ca.pugleaf.net!unknown!not-for-mailReferences:
<slrn8dfrg7.79g.jajs@Pascual.es>Show Full Headers
Complete Article Headers
X-Google-Language: SPANISH,ASCII X-Google-Thread: f86c8,fcc95392be363063 X-Google-Attributes: gidf86c8,public From: batsman@simpsons4ever. (batsman) Subject: Re: Ayuda del algun guru del Python ese o me paso al Perl :) Date: 2000/03/22 Message-ID: <52gbb8.1h1.ln@simpsons4ever> X-Deja-AN: 601028977 Content-Transfer-Encoding: 8bit References: <slrn8dfrg7.79g.jajs@Pascual.es> Content-Type: text/plain; charset=iso-8859-1 X-Complaints-To: abuse@news.wanadoo.es X-Trace: m2newsread.uni2.es 953761403 62.36.25.70 (Wed, 22 Mar 2000 22:43:23 MET) Organization: Wanadoo Usenet News - Visita http://www.wanadoo.es/ Mime-Version: 1.0 Reply-To: see_signature-mira_firma NNTP-Posting-Date: Wed, 22 Mar 2000 22:43:23 MET Newsgroups: es.comp.os.linux.programacion