This is the code from one of the clients used in the post "Statistics on getting a random row from a table" to check for the quickest way to access a random row.

It does nothing but reading a thousand random rows, I hope it's enough for you to learn how to access MySQL databases using Perl and use it as a quickstart for your own scripts.

#!/usr/bin/perl

use DBI;
use DBD::mysql;

$platform = "mysql";
$database = "database";
$host = "server_ip";
$port = "3306";
$user = "user";
$pw = "12345";

$dsn = "dbi:$platform:$database:$host:$port";

$connect = DBI->connect($dsn, $user, $pw);

for ($i=0; $i<1000; $i++)
{
    $query = "SELECT COUNT(1) AS total FROM bench_myisam";
    $query_handle = $connect->prepare($query);
    $query_handle->execute();

    $query_handle->bind_columns(\$total);

    if ($query_handle->fetch())
    {
        $rand = int(rand($total));

        $query = "SELECT id FROM bench_myisam LIMIT 1 OFFSET $rand";
        $query_handle = $connect->prepare($query);
        $query_handle->execute();

        $query_handle->bind_columns(\$id);
        $query_handle->fetch();
    }  
}

   Ver los comentarios

To install CPAN Perl modulos is easy once you know the exact command. For instance, here you got the command to install the JSON module... Installing other modules is that easy, just change the module name.

perl -MCPAN -e 'install JSON'

   Ver los comentarios

Instalar modulos de Perl es muy sencillo una vez que se dispone del comando exacto, que por ejemplo, para instalar el modulo JSON seria el siguiente:

perl -MCPAN -e 'install JSON'

   Ver los comentarios

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);

   Ver los comentarios

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!

   Ver los comentarios

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;"

   Ver los comentarios

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); }

   Ver los comentarios

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.*

   Ver los comentarios

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++; }

   Ver los comentarios

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'

   Ver los comentarios

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.

   Ver los comentarios

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 ()
{
$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.\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?

   Ver los comentarios

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

   Ver los comentarios

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í.

   Ver los comentarios