Perl es divertido

Se me ocurrió buscar si se podía usar utf8 en el nombre de las subs en perl. Resulta que sí.

use strict; use warnings;
use feature 'say';
use utf8;

sub ña() {
    say "Soy una eñe";
}
sub ᐁ() {
    say "Soy un triángulo";
}

ña;
ᐁ;

Resulta en:

Soy una eñe
Soy un triángulo

Es tarde, pero se pueden hacer miles de dibujitos con estos caracteres. Perl siempre tuvo eso de poder hacer pavadas como esas (perl golf, dark perl) así que no es nada nuevo.

Les dejo un gato, que mira lo que hice y se pregunta porqué hago esto.

Aventuras con mi teclado nuevo II

Sigo con mi teclado nuevo. Resulta que el teclado de mi notebook está en español "latam" y este nuevo está en "es". Quiero que cada uno esté en el idioma que le corresponde. Sí, así de cabeza dura soy.

Para eso se usa "setxkbmap":

 setxkbmap -device 3 latam
 setxkbmap -device 11 es

¿Cual es cual? Ese número de device se encuentra con xinput:

  xinput -list
⎡ Virtual core pointer                          id=2    [master pointer  (3)]
⎜   ↳ Virtual core XTEST pointer                id=4    [slave  pointer  (2)]
⎜   ↳ SynPS/2 Synaptics TouchPad                id=14   [slave  pointer  (2)]
⎣ Virtual core keyboard                         id=3    [master keyboard (2)]
    ↳ Virtual core XTEST keyboard               id=5    [slave  keyboard (3)]
    ↳ Power Button                              id=6    [slave  keyboard (3)]
    ↳ Video Bus                                 id=7    [slave  keyboard (3)]
    ↳ Power Button                              id=8    [slave  keyboard (3)]
    ↳ Sleep Button                              id=9    [slave  keyboard (3)]
    ↳ WebCam SCB-1900N                          id=10   [slave  keyboard (3)]
    ↳ SINO WEALTH USB KEYBOARD                  id=11   [slave  keyboard (3)]
    ↳ SINO WEALTH USB KEYBOARD                  id=12   [slave  keyboard (3)]
    ↳ AT Translated Set 2 keyboard              id=13   [slave  keyboard (3)]

Hermoso. Salvo que es bastante molesto, porque uno está acostumbrado a encontrar el acento o los corchetes en un lugar. Así que no sé qué voy a hacer.

Aventuras con mi teclado nuevo I

Me compré un teclado (simil) mecánico, con backlight (luz de fondo). Para prenderlo o apagarlo se aprieta "Scroll lock".

NOTA: Extrañamente esa tecla está escrita con "Bloq Num", y hay otra tecla con lo mismo en el pad numérico. "Block Num" y "Scroll Lock" no es lo mismo. 

Pero cuando uno lo enchufa a una computadora que tiene linux, ¡la luz no se prende! Investigué un poco pero no pude encontrar porqué. Sólo encontré que hay una forma de prender los leds de un teclado con un comando: uno puede prender de a uno o todos a la vez:

# Prende el led 1. No se sabe qué led es. ¿Cambiará de teclado en teclado?
# En el mío no cambia nada, pero sería así:
xset led 1


# Para apagarlo.
xset -led 1

# Para prender todo
xset led

# Para apagar todo
xset -led

 Este teclado tiene solo un led, el de 3 (Scroll Lock). Como también se puede apagar y prender con el nombre de la tecla, hago eso.

xset -led named "Scroll Lock"
xset led  named "Scroll Lock"

Sin embargo ahora tengo un comando, pero yo quiero poder apretar Scroll Lock y que se prenda y apague. En KDE se puede configurar que al apretar una tecla ejecute algo, asì que hice un script para que cambie el estado del led según esté.

#/bin/bash
# Este script prende o apaga (debería llamarse "lapegue") la luz del
# fondo del teclado "Dragon gaming keyboard" que me compré en enero/15.
# Es un teclado pseudo-mecánico.

# Para debug (al principio costó que funcionara con la tecla Bloq Num)
# exec 1>> /tmp/qq
# exec 2>> /tmp/qq
# 0 si lo encontró, 1 si no lo encontró.
xset q | grep "Scroll Lock: on" 
OUT=$?
# echo $OUT

if ( [ $OUT -eq 0 ] )
then
    # Está prendido.
    xset -led named "Scroll Lock"
else
    # Apagado.
    xset led named "Scroll Lock"
fi

xset es el comando que da información sobre el estado de los leds:

  xset q
Keyboard Control:
  auto repeat:  on    key click percent:  100    LED mask:  0000003c
  XKB indicators:
    00: Caps Lock:   off    01: Num Lock:    off    02: Scroll Lock: on
    03: Compose:     off    04: Kana:        off    05: Sleep:       off
    06: Suspend:     off    07: Mute:        off    08: Misc:        off
    09: Mail:        off    10: Charging:    off    11: Shift Lock:  off
    12: Group 2:     off    13: Mouse Keys:  off

[...]

Si dice "Scroll Lock: on" quiere decir que la luz está prendida.

Finalmente, lo agregamos a la configuración de KDE. Primero ir a System Settings -> Shortcut and Gestures -> Custom Shorcuts. Luego crear una nueva entrada (yo le puse "keyboard_backlight")  con Edit -> New -> Global -> Command/URL y poner ahí el nombre del script de más arriba.

Tip: Cómo agregar texto a una imagen con ImageMagick

Hola!

    Necesito agregar la fecha a una imagen. Algún día les contaré qué estoy haciendo :P

    Tengo esta imagen, saca de The Humble Yogini - Observations from the realm of Samsara:








Y con este comando, ¡pasen y vean! , le agregamos tóscamente la fecha:

 /usr/bin/convert \
        Computer_color_spectrum.jpg \
        -pointsize 38 -font URW-Bookman-L-Light \
        -annotate +80+100 "$(date --rfc-3339=date)"  \
         /tmp/colores.gif

 


Y quedó así:



         Tada!





Saludos!
 -- Diego.

Cómo sacar algunos sigils ($@%&), parte 4

Esto es... no sé qué es. Es una chanchada. Es otro forma de sacar sigils. No creo que deba usarse, pero acá está:

Cuando uno usa objetos en perl (sean hechos con Moo(se) o de cualquier otra forma) (pero hay que usar Moo(se) :) ), hace algo así:

use MiClase;
my $objeto = MiClase->new();

Y después usamos los atributos y métodos de $objeto. Supongamos que sirve para guardar frases célebres:

use Quote;
my $q = Quote->new();
$q->set_phrase("Un problema imaginario es la raíz de
                               todo pensamiento negativo");
print "La frase es: " . $q->get_phrase . "\n";

Con esto podemos tener (instanciar) un montón de objetos "Quote".

my $q = Quote->new();
my $otra_q = Quote->new()
my $otro = Quote->new()

Pero también podríamos evitar los sigils, no instanciando (creando) un objeto, sino usando la clase. Esto es horrible, y no debe hacerse, pero WTH, lo hago igual :)

 use Quote;
Quote->set_phrase("Un problema imaginario es la raíz de
                                    todo pensamiento negativo");
print Quote->get_phrase() . "\n";

 Este es el código de Quote.pm

package Quote;

use strict;

our $self;

# Cuando se llama a la clase directamente, el primer argumento
# es justamente el nombre de la clase. No nos interesa.
sub set_phrase {
  my $class = shift;
  my $phrase = shift;
  $self->{phrase} = $phrase;
}

sub get_phrase {
  my $class = shift;
  return $self->{phrase};
}

1;

Sinceramente, no sé cuán horrible es esto. Qué efectos secundarios tendrá. Le encontré por lo menos una, que es que la clase/objeto es global. Osea, si le ponés un valor a la frase, lo va a tener dentro de toda sub. Supongo que hay alguna forma de cambiarlo. Les dejo un gato:

Pequeño ejemplo de crear archivos ical con Perl

¡Hola de nuevo!

    Estuve trabajando en un programa que en una parte guarda eventos en un archivo ical. Me costó un poco encontrar un buen módulo. El mejor y más sencillo es Tie::iCal, aunque verán que tiene un bug al final.

sub guardar_evento {
    # segundos: tiempo que falta para el final del evento
    # contenido: la descripción del evento (ej "Reunión con Pepe")
    my ($segundos, $contenido) = @_;
    my %my_events;
    my $calfile = "/.mycalendar.ics";
    tie %my_events, 'Tie::iCal', $calfile or die "Failed to tie file!\n";

    # Summary no puede tener enter, así que lo cambio por \n
    $contenido =~ s/\n/\\n/gs;


    # Cada evento es una entrada, y c/u tiene un UID
    my $uid = time();
    $my_events{$uid} = [
    'VEVENT',
             {
              'SUMMARY' => $contenido,
              'DTSTART' => secs_to_ical_date(0),
              'DTEND'   => secs_to_ical_date($segundos),
             }
    ];
    untie %my_events;
}


# Esta func agrega $secs segundos a la fecha/hora actual
# y lo devuevle en el formato para iCal
sub secs_to_ical_date {
    my ($secs) = @_;

  
    # Usamos Time::Piece, que viene con Perl y nos lo hace más facil
    my $now = mk_time_piece_now();
    $now += $secs;
    my $date = $now->strftime( "%Y%m%d" )  . "T" .
               $now->strftime( "%H%M00" ) . "Z";
    return $date;
}

sub mk_time_piece_now {
      # Esto pasa porque el objeto Time::Piece que resulta de
      # localtime tiene mal el timezone. Así que lo hago string,
      # y lo vuelvo a hacer objeto. Grrrr.
      my $now        = localtime;
      my $now_string = $now->strftime("%d-%m-%Y %H:%M");
         $now        = Time::Piece->strptime($now_string, 
                                            "%d-%m-%Y %H:%M");
      return $now;
}


Pero resulta que el archivo iCal queda mal hecho, así que este pedazo de código lo arregla. Reporté el bug acá.

open( my $ical, "<", ".mycalendar.ics") or die $!;

my $head = "";
foreach my $n (1, 2, 3) {
     my $temp = <$ical>;
     $head = $head . $temp;
}

my $body = "";
while ( <$ical> ) {
    next if ( /BEGIN:VCALENDAR/ );
    next if ( /VERSION:/ );
    next if ( /PRODID:/ );
    next if ( /END:VCALENDAR/ );
    $body = $body . $_;
}

my $foot = "END:VCALENDAR\n";

# Y escribirlo a un archivo.
use File::Slurp;
write_file( ".mycalendar_fixed.ics", $head . $body . $foot );



Dos bugs. No está nada bien :(

Les dejo un conejo.



Saludos!
-- Diego

Slides sobre Moose, la implementación moderna de OO de perl

estoy con fiaca de escribir :P

Diapositivas, o tutorial con pocas letras sobre el sistema de OO de perl (el nuevo), con todos los roles, mixins y magia que hay en el mundo de la programación OO.


Les dejo un camello:

Algo más quería postear, pero no me acuerdo...

Como pasar un color a transparente en una imagen

Acabo de sorpenderme de los sencillo que es esto. Había abierto el gimp, pero ImageMagick la rompe.

convert image.png -transparent <color> nueva_img.png

donde <color> es un color, justamente. Yo lo probré con white, y funcionó.

Cómo ver algunos partidos sin flash

Nota posteriror: Estoy funciona, salvo que por lo menos en mi caso, la conexión a el sitio web que da el streaming de video se vuelve *muy* lenta cuando hay un partido, así que no lo puedo ver. Sin embargo, queda acá por si alguien quiere mirar otros programas, o tiene una mejor conexión .

----

Hola,

    Ayer estuve viendo cómo ver los partidos del mundial por canal 7 (y mirá que no dije ATC) sin usar el navegador. En linux, el plugin de flash funciona lento, así que quería verlo con un programa específico para mirar videos, como mplayer o vlc.

    Resulta que para usan un protocolo llamado "HDS". Les contaría de qué se trata, pero no tengo ganas. En definitiva, hay que usar el script AdobeHDS.php que se puede bajar acá. El script necesita la URL del archivo "manifest", que es el que describe de dónde bajar el stream de video, y el contenido del encabezado "Referrer" del pedido HTTP.

    Para encontrar la URL y el valor del encabezado, yo usé firefox, así: 

• Abrir el sitio web donde está la señal del canal para ver.
• Abrir la pantalla de información sobre el tráfico de red, yendo a Tools -> Web Developer -> Network, o apretando Ctrl + Shift + Q.
• En el navegador, poner a ejecutar el stream de video.
• Hacer click con el botón derecho sobre la línea del archivo "manifest". Elegir "Copy URL". En la imagen, la línea correspondiente.

• Hacer click con el mouse sobre esa misma línea. Aparecerá un panel a la derecha:

• Buscar en ese panel, bajo el título "Request headers", la línea que dice "Referrer", y copiar la URL que le corresponde.
• Ejecutar AdobeHDS:php con los dos parámetros tal que guarde el video en un archivo:

 php AdobeHDS.php --manifest URL_del_manifest --referrer URL_de_Referrer --outfile partido.flv 

• En otra terminal, ejecutar mplayer o el visor de videos que uno quiera.

Eso es todo. Tiene, sin embargo, algunas contras.

Primero, hay que elegir a mano la calidad. Si se elige una más alta de la se puede, el video se va a cortar, porque mplayer va a llegar al fin del archivo. Osea, mplayer le va a "ganar" a AdobeHDS.php. Con volver a ejecutar todo es suficiente, pero bien puede pasar.

El protocolo HDS está pensado para enviar video en tiempo real, evitando el buffering. Esta solución lo usa (el cache de mplayer), así que el video tiene una demora de unos segundos. Osea, que puede pasar que el vecino grite "¡Gol!" y el video empiece a mostrar la jugada. A mi me parece muy conveniente, así puedo distraerme de partidos aburridos y alguien me avisa cuando está por pasar algo interesante. Pero seguramente sea una contra para mucha gente.

Saludos
 -- Diego.

Cómo sacar algunos sigils ($@%&), parte 3

Algunas ideas que se me ocurrieron a partir de las dos entradas anteriores:

• Podemos hacer que al declarar las variables en BEGIN, ya que estamos, le agreguemos un default.

BEGIN {
        var "espia" => "James Bond";
        var "jefe"    => "M5";
        var "familia_que_ignora_la_verdad"  => "No tiene";
}

Solo hay que cambiar un poco el corazón de todo esto:

# Esta es la subrutina que genera las demas.
sub var ($;$) {
        say "Creando $_[0]... Hecho!" if $debug;
        my $p = "main"; # El namespace esta fijo en "main". TODO.

        # Si la sub que queremos que exista se llamara "espia" esto de abajo
        # sería: *main::espia = sub ...
        # El segundo argumento, si hay, es el default de la "variable" / sub.

        no strict 'refs';
        *{"${p}::${_[0]}"} = sub (;$) :lvalue {
                state $internal = "**internal**";
                if ( $_[0] ) { $internal = $_[0]; }
                return $internal;
        };
        &{"${p}::${_[0]}"} = "$_[1]" if $_[1];
        use strict;
}

• También podríamos poner otras opciones en las definiciones:

BEGIN {
        var "nombre" => "NN", validate => { $_[0] !~ /admin|root/i };
        var "jefe"    => "M5",     validate => { $_[0] != nombre };
        var "edad" => 1, max => 18;
}

• También podríamos poner otros nombres en vez de var, con otros restrains:

BEGIN {
        var "nombre" => "NN", validate => { $_[0] !~ /admin|root/i };
        bool "es_jefe"    => "true",     validate => { ... };
        int "edad" => 1, max => 18;
}

 Ya estoy delirando, porque para eso debe haber varios módulos hechos por gente que sabe más que yo :) Pero este, "casero", tiene muy pocas líneas de código.

Saludos!
 -- Diego.

Cómo sacar algunos sigils ($@%&), parte 2

Buenas! En la entrada anterior habíamos llegado a poder escribir una variable sin sigil, así:

boo = "Cuidado!!";
print boo . ", te vas  a caer de las escaleras!\n";

(estas "variables" en realidad son subrutinas, pero nadie tiene porqué saberlo :D Vamos a llamarlas variables igual, o a lo sumo "nuestras variables especiales", porque les tenemos mucho cariño).

Hay que declarar cada una de las variables como una subrutina. Un montón de copiar y pegar de código, repetido y dificil de mantener. Y ¡ay! si tenés que hacer algún cambio.

¿Se puede hacer más dinámico? No perfectamente como yo hubiera querido, pero zafa bastante bien.

Necesitamos primero definir cada variable con "var". Var no es más que una subrutina, que va a generar nuestra "variable especial".

var "espia";
var "amante_de_espia";

y luego podemos usarlas:

espia = "James Bond";
amante_de_espia = "Mariam D'Abo";
say "Mi nombre es " . espia ", y me acuesto con " . amante_de_espia;

Ningún sigil. ¡Genial!  ¿Cómo se hace? Es medio complicado, pero acá va:

"espia" y "amante_de_espia" son en realidad funciones (lo vimos en la primera parte), asi que "var" tiene que crearlas al vuelo. Para eso tiene que ponerlas en el mismo namespace, osea, al mismo nivel que el programa principal.

sub var ($) {
        my $p = "main";
        no strict 'refs';
        *{"${p}::${_[0]}"} = sub (;$) :lvalue {
                state $internal = "**internal**";
                if ( $_[0] ) { $internal = $_[0]; }
                return $internal;
        };
        use strict;
}

La parte horrible de esto, como se ve, es la cuarta linea.

*{"${p}::${_[0]}"}

$p es "main" (linea 2) y ${_[0]} es $_[0] escrito minuciosamente. Sí escribimos: var "espia", $_[0] es "espia". Osea, que queda:

*main::espia

Que quiere decir que vamos a manejar el nombre "espia", en el namespace "main", exactamente donde nuestro programa lo va a ir a buscar.. Vamos bien.

La línea completa es así:

*main::espia = sub (;$) :lvalue {

Que dice que nuestro nombre "espía" va a ser una función, igual que la que que vimos en la entrada anterior. Ese es todo el truco para insertarla en el espacio de nombres correcto.

Lo último que hace falta, que arruina un poco las cosas, es que el compilador, cuando revisa todo el script, encuentra que 'espia = "James Bond"' no es nada: no es una variable porque no tiene sigil, y no es una función, porque todavía no se ejecutó lo de arriba que hace que exista. Lo mejor que puede encontrar es que pongamos la definición en un bloque BEGIN:

 BEGIN { var "espia"; }

De esa manera, perl lo ejecuta primero, creando nuestras variables especiales para cuando las vaya a ejecutar. Y ¡ojo! También puede ser un buen lugar para declarar varias variables así:

BEGIN {
        var "espia";
        var "jefe";
        var "familia_que_ignora_la_verdad";
}

Creo que voy a hacer una tercera parte. Quedaron ideas :)

Saludos!
 -- Diego.

Cómo sacar algunos sigils ($@%&), parte 1

Estuve jugando a sacarle los sigils (los símbolos que indican si las variables son strings, listas o hashes (diccionarios en python))

Lo primero que podemos hacer es definir de antemano una función con un prototipo ";$", que quiere decir que la función recibe como argumento un escalar, opcionalmente. Osea, que se puede ejecutar "boo" o "boo($persona)".

#!/usr/bin/perl
use strict;
use warnings;

sub boo(;$) {
     print "Boo!";
}

Luego, para ejecutarlo, solo tenemos que llamar a la función, sin siquiera paréntesis:

#!/usr/bin/perl
use strict;
use warnings;

sub boo(;$) {
     print "Boo!";
}

boo;

Y eso nos imprime por pantalla "Boo!", como se espera.  Hagamos una mejora: si uno le da un argumento a "boo", entonces que lo guarde; si no, que lo devuelva.

#!/usr/bin/perl
use strict;
use warnings;
use 5.010;

sub boo(;$) {
        state $susto = "Default Boo";
        if ( $_[0] ) { $susto = $_[0]; }
        return $susto;
}

say "En la oscuridad, llego a la esquina y... " . boo . "!";
boo "Cuidado";
say "En la oscuridad, llego a la esquina y... " . boo . "!";

Ahora tiene un poco más de pinta de variable sin sigil. Pero ¡pidamos más! ¿Podremos asignar un valor a "boo" con un igual, como en (casi) cualquier lenguaje de programación? Por supuesto! Si le ponemos el atributo "lvalue" a boo.

#!/usr/bin/perl
use strict;
use warnings;
use 5.010;

sub boo(;$) :lvalue {
        state $susto = "Default Boo";
        if ( $_[0] ) { $susto = $_[0]; }
        return $susto;
}

say "En la oscuridad, llego a la esquina y... " . boo . "!";
boo "Cuidado";
say "En la oscuridad, llego a la esquina y... " . boo . "!";
boo = "AAAAAAAAAAH!";
say "En la oscuridad, llego a la esquina y... " . boo . "!";

Sigo con un intento, por ahora fallido, de hacer esto aún más general, en la segunda parte.

 -- Diego.

Text::Fuzzy

Acá hay un mini ejemplo de cómo usar Text::Fuzzy:

#!/usr/bin/env perl
use v5.16;
use warnings;
use Text::Fuzzy;

my $tf = Text::Fuzzy->new("latitude");
say "Levenshtein edit distance is ", $tf->distance("altitude");
$tf->transpositions_ok(1);
say "Damerau-Levenshtein edit distance is ", $tf->distance("altitude");

Tutorial de PDL::Graphics::Gnuplot

Me encontré con un video de youtube donde explican cómo usar PDL::Graphics::Gnuplot. Interesante!! 15 minutos.

Creciendo con Mojolicious

Una vez que nuestro proyecto con Mojolicious va creciendo, esto de tenerlo en un solo archivo se vuelve incómodo. Para separar los templates del código, ejecutamos:

./myapp inflate

Esto creará un directorio "templates" y pondrá los templates en el lugar indicado. A partir de ahí se pueden seguir agregando templates y haciéndo referencia a ellos como siempre:

$self->render('login');

Como instalar perl+mojolicious sin root

Quiero empezar un proyecto nuevo, y quiero que el proyecto viva completamente en un directorio. Asi, cuando quiera ponerlo en producción, puedo copiar todo el directorio y listo. Vamos a ver si podemos hacer eso ( o terminaré con algo tipo PAR o FatApp ) pero el primer paso es instalar un nuevo perl y un nuevo Mojolicious en mi $HOME. NOTA: Todos estos pasos se van a hacer como usuario, NO como root. Primero instalaremos perlbrew:

curl -kL http://install.perlbrew.pl | bash

Luego editarmos el archivo .bashrc y agregamos lo siguiente:

source ~/perl5/perlbrew/etc/bashrc

Salimos de la sesión y volvemos a entrar, o ejecutamos "bash" para que se apliquen los cambios. Instamos la última versión de perl

perlbrew install perl-5.16.0

La ponemos como default

perlbrew switch perl-5.16.0

Opcionalmente podemos instalar cpanm, que es una versión menos verborrágica de cpan. Si no lo instalamos, cambiar cpanm por cpan en todo este tutorial

cpan App::cpanminus

Y ahora, instalar Mojolicious

cpanm Mojolicious

Cubism: time series con js

http://square.github.com/cubism/

use FindBin;

Hola Encontré este módulo útil que viene con perl (osea, no hay que bajarlo aparte, ya está instalado) llamado FindBin. Sirve para saber dónde está instalado el script que estamos ejecutando. Por ejemplo, si queremos distribuir un programa que tiene un /bin con el script y un /lib con los modulos que usa ese script, podríamos poner en el script:

use lib '../lib'

Pero eso funciona solo si ejecutamos el script desde el /bin.

cd /opt/donde_instalamos_el_programa/bin

./programa.pl

Si queremos que el programa se pueda ejecutar desde cualquier lado (como cualquier programa) se usa FindBin:

use FindBin;

use lib "$FindBin::Bin/../lib";

Espero que les sea útil!

Consistent Ring Hashing

Acá hay un artículo donde se entiende qué es "Consistent Hashing" o "Consistent Ring Hashing". Básicamente es una forma de saber en qué servidor puede estar un objeto de cache, mejor que hacer Numero de servidor % cantidad de servidores.

Fatpacker

Otro bookmark: App:FatPacker mete las dependencias dentro de tu script. Todavía no vi cuán distinto es a PAR.