🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

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

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

#16600
From: batsman batsman
Date: Sat, 01 Apr 2000 00:00
300 lines
10638 bytes
-----BEGIN PGP SIGNED MESSAGE-----


    >>>> El Sat, 1 Apr 2000 00:17:17 +0200, un alien�gena
    >>>> intent� hacerse pasar por *puntero_loko,
    >>>> y escribi� en es.comp.os.linux.programacion:

>batsman dijo sobre Re: Ayuda del algun guru del Python ese o me paso al Perl :),
>en fecha: Fri, 31 Mar 2000 18:05:24 GMT
>
>|-----BEGIN PGP SIGNED MESSAGE-----
>|
>|
>|    >>>> El Fri, 31 Mar 2000 11:35:51 +0200, un alien�gena
>|    >>>> intent� hacerse pasar por drf,
>|    >>>> y escribi� en es.comp.os.linux.programacion:
>|
>|>Hola.
>|>Estoy siguiendo el hilo de esto, ya que tambien me interesa. He cogido el
>|>codigo, y me da el siguiente error:
>|>
>|>Can't locate LWP/UserAgent.pm in @INC (@INC contains:
>|>/usr/lib/perl5/5.00503/i38
>|>6-linux /usr/lib/perl5/5.00503 /usr/lib/perl5/site_perl/5.005/i386-linux
>|>/usr/li
>|>b/perl5/site_perl/5.005 .) at /home/httpd/cgi-bin/enviomovil.cgi line 7.
>|>
>|>No se nada sobre configuracion ni librerias de perl, �es que me falta algun
>|>paquete?
>|
>|Te faltan las librer�as LWP... Me pas� lo mismo cuando sub� el script a
>|sourceforge, y tuve que bajarme todo desde el CPAN; lo malo son las
>|dependencias: necesitas la libwww-perl, que depende de libnet-perl y de
>|libmime-base64-perl...
>
>Si, ya lo hice y por cierto, funciona de vicio. Por pedir pedir... s�lo le
>falta tener un .smsalias donde poner nombres y tel�fonos.

Tu tercer deseo ha sido concedido...

- -------------------------------- CORTAR --------------------------------------
#!/usr/bin/perl
#     esms, env�o de mensajes a m�viles de Espa�a 
#     Copyright (C) 2000 Mauricio Julio Fern�ndez Pradier
#
#         This program is free software; you can redistribute it and/or
#     modify it under the terms of the GNU General Public License as
#     published by the Free Software Foundation; either version 2 of the
#     License, or (at your option) any later version.
#
#         This program is distributed in the hope that it will be
#     useful, but WITHOUT ANY WARRANTY; without even the implied
#     warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#     See the GNU General Public License for more details.
#
#         You should have received a copy of the GNU General Public
#     License along with this program; if not, write to the Free
#     Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

use CGI;
use Text::Wrap qw(wrap $columns);
use LWP::UserAgent;
use HTTP::Request::Common qw(POST GET);

local $debug = 0;

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 obtener_telefono
{
 	my $alias = pop @_;
	my $fichero;
	$fichero = $ENV{"HOME"} . "/.esmsalias";
	print "Abriendo fichero de alias $fichero.\n";
	print "Buscando tel�fono de $alias.\n";
	open(INPUT, $fichero);
	while (<INPUT>) {
		chop($_);
##		print "Le�da l�nea $_.\n";
	if ( /$alias/ ) {
			s/^$alias //g;
			s/ //g;
			s/\t//g;
			$ok = 1;
			close(INPUT);
			return $_;
	}
	}
	close(INPUT);
   return 0;	
}

sub enviar_mensaje
{
 my ($linea, $telefono,$repeat) = @_;
 my $remote;

 if ($repeat == 0) {
    print "Error al enviar el mensaje: $linea\n" if ($debug);
    return;
 }
 my $ua = new LWP::UserAgent;
 $ua->agent("Mozilla/5.0 " . $ua->agent);
 # $ua->proxy("http", "http://localhost:8080/");
 # 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 $cookie_monster = GET 'http://www.terra.es/sms/';
 my $res;
 print "Obteniendo c�digo...\n" if ($debug);
 my $i = 0;
 do { 
 	$i++;
 	$res = $ua->request($cookie_monster); 
 } while (!$res->is_success && $i<10); 
 
 my @parts = split /\n/, $res->headers_as_string();
 my @cookies;
 
 foreach( @parts ) {
##   print "Analizando l�nea $_\n";
	if ( /^Set-Cookie:/ ) {
		s/^Set-Cookie: //;
		my @tmp = split /\;/ , $_;
##		print "Insertando l�nea $tmp[0]\n";
		push @cookies, $tmp[0];
	}
 }
 print "Protecci�n desactivada.\n" if ($debug);
 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 ( Referer => "http://www.terra.es/sms/" ); 
 $req->header ( Cookie => "$cookies[0]; $cookies[1]");
 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($seconds+36000);
 &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 
 # print "<br><pre>Enviando:" . $req->as_string() . "</pre><br>";
 $res = $ua->request($req);
 
 # Check the outcome of the response
 if ($res->content =~ /correctamente/) {
     print "Mensaje enviado correctamente\n" if ($debug);
     return 1;
 } elsif ($repeat > 1) {
     print "Error al enviar mensaje. Reintentando\n" if ($debug);
     my $i;
     for ($i=0; $i<3; $i++) {
         return 1 if (&enviar_mensaje($linea,$telefono,1) == 1);
	 		print "Reintentando env�o\n" if ($debug);
     }
 #    sleep(1);
     return &enviar_mensaje($linea,$telefono,$repeat-1);
 }
 print ( "Error al enviar el mensaje: $linea\n" ) if ($debug);
 return 0;
}
if ($ARGV[0] eq "") {
	print "esms 0.3, Copyright � 2000 Mauricio Julio Fern�ndez Pradier\n";
	print "esms comes with ABSOLUTELY NO WARRANTY; for details type `show w'.\n";
	print "This is free software, and you are welcome to redistribute it\n";
	print "under certain conditions; type `show c' for details.\n";
	print "\n";
	print "Uso: esms <telefono>\n";
	print "Ejemplo:\n";
	print " fortune -s | esms 123456789 \n";
	print " uname -a | esms Linus \n";
	print "\nEste �ltimo buscar� 'Linus' en el fichero de alias\n";
	print	"\t\t" . $ENV{"HOME"} . "/.esmsalias\n";
	print "Ejemplo de .esmsalias:\n";
	print "yo      123456789\n";
	print "Linus   1111111111\n";
	exit(0);
}
my $telefono = $ARGV[0];
my $name = $telefono;
if ( $telefono !~ /[0-9]+/ ) {
	$telefono = &obtener_telefono($telefono);
}
print "Obtenido tel�fono: $telefono.\n";
if ($telefono == 0)
{
	print "No se pudo encontrar el telefono asociado a $name.\n";
	exit(1);
}


my @in = <STDIN>;
my $mensaje = join ('', @in);
               
$columns = 100;
my $linea = wrap ("","",$mensaje);
my @lineas = split(/\n\n/,$linea);
my $numlineas = @lineas;

$| = 1; ## turn auto-flush on

print "Env�o de mensaje a m�vil\n";
print "Tel�fono: $telefono\n";
print "Mensaje:\n $mensaje\n";
print "Enviando mensaje:\n";
print "El mensaje ha sido fragmentado en $numlineas paquetes.\n" 
    if ($numlineas > 1); 
print "El mensaje no ha sido fragmentado.\n" 
    if ($numlineas == 1); 
sleep(1);

sub espera 
{
    my $tiempo=1;
    print "Esperando $tiempo segundo...\n" if ($debug);
    sleep($tiempo); ## wait after each message part
}
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 "\n";
    close(STDOUT);
};

- -------------------------------- CORTAR --------------------------------------


Los alias se meten en el fichero ~/.esmsalias, que ser� as�:
yo    123456789
jefe  666
linus 1

De todas formas, al llamar a esms sin par�metros ya sale esta ayuda:

esms 0.3, Copyright � 2000 Mauricio Julio Fern�ndez Pradier
esms comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.

Uso: esms <telefono>
Ejemplo:
 fortune -s | esms 123456789 
 uname -a | esms Linus 

Este �ltimo buscar� 'Linus' en el fichero de alias
		/home/batsman/.esmsalias
Ejemplo de .esmsalias:
yo      123456789
Linus   1111111111


Se nota que estoy deseando incluir ficheros y salidas de programas en mi
mensaje, ahora le he pillado el truco a vim y sus :r :-)
Por cierto, �he dicho ya que me estoy enamorando de perl?

- -- 
              _           _                             
             | |__   __ _| |_ ___ _ __ ___   __ _ _ __  
             | '_ \ / _` | __/ __| '_ ` _ \ / _` | '_ \ 
             | |_) | (_| | |_\__ \ | | | | | (_| | | | |
             |_.__/ \__,_|\__|___/_| |_| |_|\__,_|_| |_|

             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]

iQEVAwUBOOXTOL0Y27yr0iefAQF9+AgAoGqPGochbrr5KbdHfkBp63fP5O48oC/g
G7wlmfntHfL2dBFXdAp9EP7bjjSGaFTM+7X4IAiWhv2SgN9Yhy125wHtZE0rZtGj
cAdOA1Z7UfggYCQQcm96hJkBvV1Id8GMDV+GvLjuBFI6ZMA7G+e7GGTufPsK/9Y2
QHmCVTmpumJRpx3VFQZgNLteQw5s0GOQS7IGCz9y3slKIEwL6LG1LQT4mjU1Aw6L
kf+QO64WQmg5FJJ5Q8J1dR2mtTIe8YjWKcdn1yoSN+vT4pHBn1X2bphWWKw3L1eS
VxnAe/FcCTuW5+Ok6l0atCHiyqD6tpcem+of0nUn46qWiq0+c+d6Pw==
=UfWE
-----END PGP SIGNATURE-----
Technical Details
Message-ID: <tvj4c8.771.ln@simpsons4ever>
Path: arc1-ca.pugleaf.net!unknown!not-for-mail
References: <slrn8dfrg7.79g.jajs@Pascual.es> <uhfbb8.1h1.ln@simpsons4ever> <slrn8dk41r.185.jajs@Pascual.es> <rgcob8.lq1.ln@simpsons4ever> <8c1rhh$sv$1@diana.bcn.ttd.net> <cuj2c8.19.ln@simpsons4ever> <slrn8ea8vd.1rv.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/04/01
Message-ID: <tvj4c8.771.ln@simpsons4ever>
X-Deja-AN: 605219731
Content-Transfer-Encoding: 8bit
References: <slrn8dfrg7.79g.jajs@Pascual.es> <uhfbb8.1h1.ln@simpsons4ever> <slrn8dk41r.185.jajs@Pascual.es> <rgcob8.lq1.ln@simpsons4ever> <8c1rhh$sv$1@diana.bcn.ttd.net> <cuj2c8.19.ln@simpsons4ever> <slrn8ea8vd.1rv.jajs@Pascual.es>
Content-Type: text/plain; charset=iso-8859-1
X-Complaints-To: abuse@news.wanadoo.es
X-Trace: m2newsread.uni2.es 954591395 62.36.24.27 (Sat, 01 Apr 2000 14:16:35 MET DST)
Organization: Wanadoo Usenet News - Visita http://www.wanadoo.es/
Mime-Version: 1.0
Reply-To: see_signature-mira_firma
NNTP-Posting-Date: Sat, 01 Apr 2000 14:16:35 MET DST
Newsgroups: es.comp.os.linux.programacion