Por Saiyine  el 2005-06-03 00:12:00 - Secciones:  PERL  - Enlace permanente: 378

Este es el sencillisimo script en perl que uso para saber cuales son los navegadores que usan mis visitantes.

#!/usr/bin/perl $ua{"Netscape"}=0; $ua{"K-Meleon"}=0; $ua{"Safari"}=0; $ua{"Konqueror"}=0; $ua{"Opera"}=0; $ua{"Epiphany"}=0; $ua{"Firefox"}=0; $ua{"Galeon"}=0; $ua{"MSIE6"}=0; $ua{"MSIE5"}=0; $ua{"Mozilla"}=0; while (<STDIN>) { if (/Mozilla.*MSIE 6/i) { $ua{"MSIE6"}++; } elsif (/Mozilla.*MSIE 5/i) { $ua{"MSIE5"}++; } elsif (/Mozilla.*Gecko.*Netscape/i) { $ua{"Netscape"}++; } elsif (/Mozilla.*Gecko.*K-Meleon/i) { $ua{"K-Meleon"}++; } elsif (/Mozilla.*Gecko.*Safari/i) { $ua{"Safari"}++; } elsif (/Mozilla.*Gecko.*Epiphany/i) { $ua{"Epiphany"}++; } elsif (/Mozilla.*Gecko.*Firefox/i) { $ua{"Firefox"}++; } elsif (/Mozilla.*KHTML.*Gecko/i) { $ua{"Konqueror"}++; } elsif (/Konqueror/i) { $ua{"Konqueror"}++; } elsif (/Mozilla.*Opera/i) { $ua{"Opera"}++; } elsif (/Mozilla.*Galeon/i) { $ua{"Galeon"}++; } elsif (/Mozilla.*Gecko/i) { $ua{"Mozilla"}++; } } sub hashValueDescendingNum { $ua{$b} <=> $ua{$a}; } foreach $key (sort hashValueDescendingNum (keys(%ua))) { print $key." ".$ua{$key}."\n"; }

Podeis descargarlo de aquí.

Por Saiyine  el 2005-04-07 00:00:00 - Secciones:  PERL  - Enlace permanente: 385

Estoy teniendo muchos problemas con mi conexión a internet, cambiandome la ip hasta 29 veces al día, así que necesito un programa que actualice los datos de ciertas aplicaciones cada vez que haya un cambio. En el ejemplo, solo guarda la ip y la fecha en un fichero, pero se pueden añadir todo tipo de acciones en la zona central del bucle.

#!/usr/bin/perl \$interfaz="ppp0"; # O podriamos usar @ARGV[0] para obtenerlo de la linea de comandos. \$antigua=""; #Inicializamos la ip antigua a cadena vacía while () # Ejecutar siempre { open(IFCONFIG,"ifconfig $interfaz |"); # La tuberia final indica que esperamos leer la salida del ifconfig @ip=grep /inet addr:/, <IFCONFIG>; # Filtramos las lineas del resultado que contengan "inet addr:" close(IFCONFIG); @ip[0]=~s/^.*inet addr://; @ip[0]=~s/ .*\$//; @ip[0]=~s/\\n//; # Dejamos solo la ip en la cadena if (@ip[0] ne \$antigua) # Si las ip es diferente de la que teniamos guardada hacer { system("echo -e \"".@ip[0]." ".localtime()."\" >> ".$ENV{HOME}."/.iplog"); # Añadimos la nueva ip y la fecha a un fichero en nuestro directorio personal \$antigua=@ip[0]; # Actualizamos la ip que conoce el programa } sleep(300); # Esperamos 300 segundos y a volver a empezar } exit;

Descargar: iplog.pl

Por Saiyine  el 2004-12-16 00:00:00 - Secciones:  PERL  - Enlace permanente: 386

Un script que he escrito en un momento para sacar las urls que han ido saliendo en la web. Además, si hay un texto en title lo usa como explicación del enlace.

#!/usr/bin/perl while (<STDIN>) { $linea=$_; while ($linea=~/(<a href="(http[^"]+?)" target="_blank" title="([^"]*?)">(.*?)<\/a>)/i ) { $url=$2; $titulo=$3; $texto=$4; if ( !$titulo ) { $titulo=$texto; } print "<li><a href=\"$url\" target=\"_blank\" title=\"$titulo\">$titulo</a>.\n"; $linea=~s/(<a href="(http[^"]+?)" target="_blank" title="([^"]*?)">(.*?)<\/a>)//i; } }

¿Como se podria hacer que de igual si el target está o no, o que no importe el orden?

Keith Amling (23/09/2005, 13:25) Correctly handling arbitrary HTML in a regex is a little difficult. The most robust way to handle this (at least with a regex) to first check against /<a ([^>]*)>/ and then check the return from that against /title="([^"]*)"/ and /href="([^"]*)"/ separately to parse title and URL. Extracting links from HTML is a hard problem and the correct (although slow) answer is to use HTML::Parser. I apologize for English. I can pretend to read Spanish, but not to write it.

Saiyine (24/09/2005, 00:51) Hi! Yeah, the truth is that this is just a quick'n'dirty hack I can't remember right now why I wrote. Maybe for a module for this web in its pre .com era? I don't know. You're absolutely correct, the best way is to reuse the code someone, better programmer than I, wrote and put in the HTML::Parser, but it's simply that I don't like to use external libraries for this kind of things. I apologize for my English too!

Por Saiyine  el 2004-01-28 00:00:00 - Secciones:  PERL  - Enlace permanente: 387

Esta joyita aparecio hace poco en un comentario de barrapunto, la guardo aqui porque me parece un ejemplo de como acceder a ficheros binarios bastante bueno. El programa en si coge un paquete formado por varios zip's pegados y los separa conforme los va encontrando.

#!/usr/bin/perl $hb="PK\x03\x04"; $he="PK\x05\x06"; undef $/; $bulk = ; (@f)= ($bulk =~ m/(?:($hb.*?$he.{18}).*?)+/sg); for(@f) { $i++; open F, ">fw$i.zip"; print F $_ }

Vaya, ahora que lo miro, me parece que a lo mejor tiene demasiado nivel, cuando encuentre un codigo más basico de como leer y escribir en binario os lo subiré.

ACTUALIZACIÓN 23/07/2004 Como lo prometido es deuda, aqui teneis otro ejemplo más claro, este código filtra caracteres binarios y solo deja pasar los que tengan un valor ASCII entre 32 y 127 (es decir, es algo muy parecido al comando strings de UNIX):

#!/usr/bin/perl open(DFILE, "-") || die "open $!"; binmode(DFILE); $offset=0; $separador=0; while ( sysread(DFILE,$buf,1,$offset)) { if ((ord($buf)>32) && (ord($buf)<127)) { print $buf; $separador=1; } else { if ($separador==1) { print "\\n"; $separador=0; } } $offset = $offset++; next; } close (DFILE); if ($separador==1) { print "\\n"; }

Keith Amling (25/09/2005, 13:03) You might like xxd and strings.

Por Saiyine  el 2004-01-28 00:00:00 - Secciones:  PERL  - Enlace permanente: 388

Necesitaba un par de scripts que permitiesen volcar un fichero a partir de la linea que contuviese mi correo, y que dejase de escribir al llegar a la linea con el token TABLE, asi que, dicho y hecho. Estos scripts cogen la entrada standard y la copian, el primero a partir de la linea que cumpla con una expresión regular que le pasamos como parametro, y el segundo hasta una linea igualmente marcada. Aqui os pongo el mencionado primer script, dejarpasardesde:

#!/usr/bin/perl $aceptado="no"; foreach $linea (&lt;STDIN>) { if ($linea =~ /$ARGV[0]/) { $aceptado="si"; } if ($aceptado eq "si") { print "$linea"; } }

Y, por supuesto, su gemelo, dejarpasarhasta:

#!/usr/bin/perl $aceptado="si"; foreach $linea (&lt;STDIN>) { if ($linea =~ /$ARGV[0]/) { $aceptado="no"; } if ($aceptado eq "si") { print "$linea"; } }

Keith Amling (25/09/2005, 13:11) The second can be replaced with sed '/foo/,$d' and the first with sed -n '/foo/,$p'

Por Saiyine  el 2003-12-29 00:00:00 - Secciones:  PERL  - Enlace permanente: 389

Me encanta hacer calculos chorras, y es realmente comodo hacerlos cuando se dispone de una calculadora de linea de comandos (las calculadoras gráficas tipo las del windows me parecen lentiiisimas). Por ello, me he currado esta tarde esta version perfeccionada de mi calcu, con historico de valores y tal (necesita tener el bc instalado).

#!/usr/bin/perl $linea=1; $token="Arrancando"; push @historico, 0; $param = @ARGV; if ( $param != 0 ) { open (f1,"echo \"$ARGV[0]\" | bc -l |"); $salida=&lt;f1>; close(f1); print "[$linea] "; print $salida; chop $salida; push @historico, $salida; $linea++; } while ($token ne "q") { print "[$linea] "; $token=&lt;STDIN>; chop $token; if ($token eq "") { exit; } $token =~ s/($(\d+))/@historico[$2]/g; open (f1,"echo \"$token\" | bc -l |"); $salida=&lt;f1>; close(f1); $linea++; print "[$linea] "; print $salida; chop $salida; push @historico, $token; push @historico, $salida; $linea++; }

Por Saiyine  el 2003-11-02 00:00:00 - Secciones:  PERL  - Enlace permanente: 390

Este es el tipico filtro antispam basado en patrones de texto, en particular, en expresiones regulares: cuando el programa encuentra que alguna de las expresiones regulares contenidas en un fichero de filtros esta en el fichero del correo, lo marca como spam y mueve el fichero fuera de la carpeta Maildir a otra carpeta indicada en el programa. Evidentemente, se puede modificar de forma trivial para que elimine dichos correos basura, e invito ha hacer las modificaciones pertinentes si ese es el deseo del lector, pero, personalmente, precisamente hice este programa para reemplazar una funcionalidad de otro, que siempre eliminaba el spam sin informar de lo que habia hecho y por que, y para mi gusto era tomarse demasiadas libertades, sobre todo cuando esta en juego la eliminacion por error de correos importantes. Dicho, esto paso a mi programa, llamado filtroantispam:

#!/usr/bin/perl open (FICHERO, $ARGV[0]); while ( <FICHERO> ) { # Medida de seguridad importante, nunca bajar a 0 o todo sera spam if ( length ( $_ ) > 5) { $_=~s/\\n$//; push ( @filtros, $_ ); } } close(FICHERO); shift (@ARGV); # Directorio en el que guardamos los Spams $directoriospams="/home/saiyine/Spam"; # ¿Anotamos todo lo que hemos filtrado? $anotar="Si"; foreach $fichero (@ARGV) { open (FICHERO, $fichero); @lineas = &lt;FICHERO>; close(FICHERO); $esspam="No"; $alfinal=0; foreach $filtro (@filtros) { foreach $linea ( @lineas ) { if ( $linea=~/$filtro/i ) { if ( $anotar eq "Si" ) { print "$fichero contiene <$filtro>\\n"; } system ("mv $fichero $directoriospams"); $esspam="Si"; last; } } if ( $esspam eq "Si" ) { last; } } }

El fichero de filtros contiene expresiones regulares del estilo perl que si las contiene el correo lo marcaran como spam. Es importante pensar muy bien la expresion regular, ya que una regex demasiado ambigüa puede hacer pensar al programa que todo lo que te llegue es spam, lo que te haria tener que estar mirando de vez en cuando en el deposito de correos basura, cosa que tampoco estaria demasiado mal hacer de vez en cuando "por si acaso". Este es un ejemplo con las primeras lineas de mi fichero de filtros

From:.*dannimail* Subject:.*orreo.*asura.*$ Subject:.*natural.*figures.* From:.*pills\.com.* From:.*internet.*deals.* Subject:.*[V|v][i|1]agra.*

Por Saiyine  el 2003-10-28 00:00:00 - Secciones:  PERL  - Enlace permanente: 391

Ayer en clase de Algoritmos II el profesor comento, ante el pasmo de la concurrencia, que estaba pensandose poner como practica hacer un buscador de internet, y que iba a dar UN MILLON de paginas para hacer las busquedas. Evidentemente, añadio, no se iba a poner a bajar un millon de paginas de internet, asi que estaba estudiando como hacer un programa que las generase.

Asi que pense, pues vaya, no tiene mucha complicacion, eso lo hago yo en diez minutos, y efectivamente, eso fue mas o menos lo que tarde en programarlo anoche cuando llegue a mi casa. Es, claro, una prueba de concepto, hay mucho que pulir, pero basicamente ya funciona, por la entrada estandar le pasas un fichero de texto para que se haga un diccionario, y crea tantos ficheros .html con texto al azar como le digas, y mas o menos del tamaño que le indiques. Aqui lo teneis, GenerarHTML:

#!/usr/bin/perl $param = @ARGV; if ( $param != 2 ) { print "Uso: GenerarHTML ficheros tamaño_aproximado\\n"; print " GenerarHTML 100 50000\\n\\n"; exit; } srand(); @entrada = &lt;STDIN>; $param = "@entrada\n"; while ( $param =~ /\b(\w+)\b/ ) { $param =~ s/\b(\w+)\b//; push @palabras,$1; } $numpalabras = @palabras; foreach $fichero (1..$ARGV[0]) { open (f1,">".$fichero.".html"); $escrito=0; while ( $escrito &lt; $ARGV[1] ) { $numerito=int ( rand ( $numpalabras ) ); print f1 $palabras[$numerito]; if ( $numerito % 10 == 0) { print f1 "\\n"; } else { print f1 " "; } $escrito=$escrito+length($palabras[$numerito])+1; } close(f1); }

Por Saiyine  el 2003-08-07 00:00:00 - Secciones:  PERL  - Enlace permanente: 392

Estas simples lineas me generan la frase pseudo-aleatoria que incluyo en mis paginas y en mi firma del correo. Simple, verdad? Lo unico infrecuente es esa regex, que prefiero al chop para evitar que este se coma la ultima letra de la entrada si no es un cambio de linea. Sin mas preambulos, (frasealazar):

#!/usr/bin/perl @frases=&lt;STDIN>; foreach $linea (@frases) { $linea =~ s/\n$//; } srand(); print "$frases[int(rand(scalar @frases))]\\n";

Keith Amling (25/09/2005, 13:17) perl's chop and chomp can perform =~ s/\\n$//. chop always removes the last character and chomp removes it if it is a newline. In this case "chomp $linea;"

Por Saiyine  el 2003-08-05 00:00:00 - Secciones:  PERL  - Enlace permanente: 393

Necesitaba un programa que eliminase las lineas repetidas de un texto, y como el uniq del UNIX es practicamente inutil, tuve que currarmelo yo (unique):

#!/usr/bin/perl @lineas = &lt;STDIN>; foreach $linea (@lineas) { $estaba="Pono"; foreach $cadena (@repasadas) { if ($cadena eq $linea) { $estaba="Pozi"; } } if ($estaba eq "Pono") { push @repasadas, $linea; print "$linea"; } }

ACTUALIZACIÓN 23/07/2004 Usando diccionarios, _muchísimo_ más rápido.

#!/usr/bin/perl while (<STDIN>) { if (!(exists $lineas{$_})) { print "$_"; $lineas{$_}="1"; } }

Keith Amling (25/09/2005, 13:22) uniq is designed for use with sorted text. If you sort the input first it will handle it correctly, for example $ cat file c a a b a $ cat file | uniq c a b a $ cat file | sort | uniq a b c If you need the lines sorted as they were initially then uniq is useless. While I'm on the subject of uniq, don't forget uniq -c.

Saiyine (25/09/2005, 23:41) Yeah, that was right the problem, I didn't wanted sort to mess with the order. Thanks for this lot of commentaries!

Por Saiyine  el 2005-09-18 23:28:00 - Secciones:  PERL  - Enlace permanente: 558

Para un experimento, necesitaba una lista bastante larga de números primos, lo que me indujo a hacer este programita en perl.

El script es realmente simple, y practicamente no usé ningún truco para acelerar la generación de primos salvo el empezar con una lista de ocho o nueve precalculados.

Los números generados son guardados en un txt que es reaprovechado la siguiente vez que se ejecuta el programa, que por cierto acepta como parametro cuantos primos queremos calcular.

Y sin más preambulos, el código:

#!/usr/bin/perl

if (-e "primos.txt")
{
  open (f1,"primos.txt");
  @leido=<f1>;
  close(f1);
  foreach $l ( @leido )
  {
    if ($l > 0)
    {
      push (@primos, $l*1);
    }
  }
} else
{
  @primos = (2,3,5,7,11,13,17,19);
}

$a = pop (@primos);
push (@primos, $a);

if ( $ARGV[0]==0 )
{
  $tope=1;
} else
{
  $tope=$ARGV[0];
}

$cuenta=0;
do
{
  $primo = "Si";
  foreach $p (@primos)
  {
    if ( $a % $p == 0 ) 
    {
      $primo = "No";
      break;
    }
  }
  if ( $primo eq "Si" )
  {
    $cuenta++;
    print "[ $a ] $cuenta\n";
    push (@primos, $a);
  }
  $a=$a+1;
}
while ($cuenta<$tope);

open (f1,">primos.txt");
foreach $i ( @primos )
{
  print f1 "$i\n";
}
close(f1);