Código del Día: Phrasier

No pude recordar una frase que oí en una película, y al buscarla en internet, noté lo divertido de las frases que calzaban. Así que hice un pequeño script en Perl que hace una búsqueda en Google por el comienzo de una frase, y te devuelve las ocurrencias. Se me ocurrió el not-so-clever nombre de Phrasier.

Si no encuentran los módulos necesarios, usen el maravilloso CPAN (por ejemplo, perl -MCPAN -e "install HTTP::Lite")

#!/usr/bin/perl
use HTTP::Lite;
use HTML::TreeBuilder;
use HTML::FormatText;
use locale;
use strict;
my $phrase = $ARGV[0] || "it can be ruined by";
my $num = $ARGV[1] || 100;
my $escaped_phrase = $phrase;
$escaped_phrase =~ s/\s+/+/gs;
my $http = new HTTP::Lite;
my $req = $http->request("http://www.google.com/search?num=$num\&as_epq=$escaped_phrase")
        or die "Unable to get document: $!";
my $formatter = HTML::FormatText->new;
my $body = $formatter->format(HTML::TreeBuilder->new->parse($http->body()));
my %lines;
while ( $body =~ /($phrase ([\w \n{1}]+))/gi ) {
        my $k = lc $1;
        chomp $k;
        $k =~ s/\n+/ /g;
        $k =~ s/\s+/ /g;
        $k =~ s/^\s+|\s$//g;
        $lines{$k}++;
}
foreach (sort keys %lines) {
        print "$_\n";
}

Por ejemplo, acá hay una salida:

leus@desarrollo:~> perl phrasier
it can be ruined by a poor translat
it can be ruined by cheaters
it can be ruined by the ingestion of headphones or other foreign objects
it can be ruined by bad storage
it can be ruined by graffiti
it can be ruined by a criminal act
it can be ruined by being shown in bad light
it can be ruined by continual overheat
it can be ruined by a poor set of eyes
it can be ruined by some little thing
it can be ruined by misusing it
it can be ruined by acting on thoughtless suggestions
it can be ruined by the time it arrives
it can be ruined by the earthquake as well
it can be ruined by sitting too long
it can be ruined by just one person
it can be ruined by bad texturing
it can be ruined by cars driving over it
it can be ruined by a cloth that is totally soft to the touch
it can be ruined by small mistakes
it can be ruined by bad scratching of the read surface
it can be ruined by those who
it can be ruined by just one application of liquid fertilizer
it can be ruined by a failure to ask for enough resources to complete it
it can be ruined by a bad mic
it can be ruined by liquids
it can be ruined by people sometimes
it can be ruined by falling in love
it can be ruined by what you decide to do in the very early stages of creating
it can be ruined by people who thinks that the whole world owes them a living when in fact we all could not give a
it can be ruined by the slightest
it can be ruined by everyone else
leus@desarrollo:~>

Ya saben,  it can be ruined by sitting too long. ¿Cómo funciona en español? No sé...

leus@desarrollo:~> perl phrasier "a veces" 40
a veces a diario
a veces a mil
a veces a veces
a veces casi no es
a veces con ojos
a veces creo que es bueno darse una cagadita
a veces cómicas e inclusive amargas
a veces escribe cartas para no sentirse atado
a veces escribo cartas
a veces escribo cartas para no sentirme atado
a veces escribo cartas se ha mudado
a veces hago un viaje
a veces hiel
a veces invento dias
a veces invento días
a veces llegan cartas
a veces llegan cartas con olor a espinas que no son románticas
a veces llegan cartas con sabor amargo
a veces mata
a veces me sale el italiano que llevo
a veces me sale el italiano que llevo dentro y dejo la tendalada
a veces miel
a veces no apaga despues del
a veces no es tan buen amigo
a veces pienso con el bíceps
a veces pueder ser un pecado
a veces son buenas
a veces soy guuena
a veces suenas extremista
a veces tambien
a veces traen
a veces traen problemas envía a un amigo las abuelas dan un apoyo importante a las madres jóvenes
a veces tú
a veces una brisa suave
a veces veíamos el playboy
a veces yo
leus@desarrollo:~>

Eh, a veces creo que es bueno darse una cagadita. Las joyitas que uno encuentra con este script.