🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: es.comp.os.linux.programacion
Article #16788

Re: Ayuda del algun guru del Python ese o me paso al Perl :)

#16788
From: batsman batsman
Date: Wed, 22 Mar 2000 00:00
170 lines
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-mail
References: <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