Archives septembre 2010

L'outil du jour a probablement déjà été écrit, et réécrit par les trois-quarts des programmeurs de la planète, mais bon, cela fait partie de la petite gym hebdomadaire.

J'avais donc besoin d'un outil me permettant de télécharger les fichiers d'un podcast en ligne de commande. Rien de complexe donc, et aucun outil qui faisait déjà le travail à ma connaissance (et j'avoue ne pas avoir cherché !).

Voici le script :

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

package App::podcaster;

use Getopt::Long;
use LWP::UserAgent;
use XML::LibXML;
use File::Spec;
use File::Basename;
use Carp;
use Term::ANSIColor;

__PACKAGE__->run() unless caller();

sub new {
    my ( $class, %args ) = @_;
    my $self = {};

    $self->{url}        = delete $args{url};
    $self->{output_dir} = delete $args{output_dir} || './';
    $self->{ua}         = LWP::UserAgent->new(
        agent         => 'Mozilla/5.0',
        show_progress => 1,
        cookie_jar    => {},
    );

    bless $self, $class;
}

sub run {
    my $config = {};
    GetOptions( $config, 'url=s', 'output_dir=s' );
    die _usage() unless _valid($config);

    my $podcaster = App::podcaster->new(
        url        => $config->{url},
        output_dir => $config->{output_dir},
    );

    $podcaster->download_enclosures();
}

sub get_enclosures {
    my ($self) = @_;

    my $res = $self->{ua}->get( $self->{url} );
    if ( $res->is_success ) {
        my $xml       = $res->decoded_content;
        my $feed      = XML::LibXML->load_xml( string => $xml );
        my @nodes     = $feed->findnodes('//enclosure/@url');
        my @encl_urls = map { $_->value } @nodes;
        return @encl_urls;
    }
    else {
        carp $self->{url}, $res->status_line, $/;
    }
}

sub download_enclosures {
    my ($self) = @_;

    my @encl_urls = $self->get_enclosures();
    for (@encl_urls) {
        my $output_filename = $self->_get_filename($_);
        if ( not -e $output_filename ) {
            my $res =
              $self->{ua}->get( $_, ':content_file' => $output_filename, );

            if ( $res->is_success ) {
                print colored(
                    ['green'], basename($output_filename) . " is downloaded."
                ), $/;
            }
            else {
                print colored(
                    ['red'],
                    basename($output_filename)
                      . " can't be downloaded: "
                      . $res->status_line
                ), $/;
            }
        }
        else {
            print colored( ['green'],
                basename($output_filename) . " is already downloaded." ),
              $/;
        }
    }
}

sub _get_filename {
    my ( $self, $url ) = @_;

    return File::Spec->catfile( $self->{output_dir}, basename($url) );
}

sub _valid {
    my $config = shift;
    if ( exists $config->{url} and exists $config->{output_dir} ) {
        return 1;
    }
    else {
        return 0;
    }
}

sub _usage {
    return "Usage: $0 --url http://path.to/rss.xml --output_dir ./\n";
}

1;

Le script est un modulino, essentiellement car je pense que ce n'est que la première version de l'outil. J'ai déjà quelques idées de fonctionnalités à ajouter !

En ce qui concerne l'algorithme, c'est assez simple :

1. le programme prend deux arguments, l'URL du podcast et le répertoire où les fichiers doivent être téléchargés ;
2. nous récupérons le contenu de l'URL du podcast ;
3. nous utilisons une expression XPath, //enclosure/@url, pour récupérer les URLs des différents fichiers ;
4. nous téléchargeons les différents fichiers.

Simple, efficace, et j'ai maintenant un outil en ligne de commande pour mes podcasts !

Comme beaucoup de Perl Mongers, je suis un fan absolu du CPAN. Oui, on y trouve le pire comme le meilleur, mais je dois avouer que je peux vivre facilement avec le pire d'une part en n'installant pas ces modules (autant que possible), mais aussi parce qu'une recherche sur le CPAN m'économise souvent beaucoup de temps.

Et ce dernier m'est tellement utile que j'accepte aussi de sacrifier une partie de l'espace de mon disque dur pour le transporter tout le temps avec moi. Cette opération est réalisée avec le script minicpan, disponible … sur le CPAN. L'outil s'appuie sur un fichier de configuration assez simple :

remote: http://ftp.belnet.be/mirror/ftp.cpan.org/
local: /home/manu/toolbox/minicpan
exact_mirror: 1

Cela me permet d'une part d'avoir de la lecture en abondance lors de mes déplacements, mais aussi, plus sérieusement, à pouvoir installer de nouveaux modules même lorsque je n'ai pas de connexion internet.

Il est alors nécessaire de modifier la configuration de cpan de manière à ce qu'il utilise les ressources locales plutôt que les ressources distantes. Voici un bref rappel des commandes cpan utiles dans cette situation :

• o conf urllist, cela va afficher les URL utilisées par cpan pour rechercher et installer des modules ;
• o conf urllist unshift file:///home/manu/toolbox/minicpan, permet de rajouter une URL au début de la liste des URL ; comme cpan utilise la liste dans l'ordre, cela permet de donner la priorité à une ressource ;
• o conf urllist shift, permet quant à elle de supprimer le premier élément de la liste ;
• je vous laisse jouer avec o conf urllist pop et o conf urllist push something !
• évidemment, ne pas oublier d'utiliser o conf commit pour sauver la configuration pour le prochain appel à cpan, sauf si vous avez appelé la commande o conf auto_commit 1 auparavant.

Avec le CPAN est une chose, mais il est assez agréable aussi de pouvoir interroger le dépôt via une interface plus agréable que locate, find et autre grep. C'est pour cela que j'ai installé CPAN::Mini::Webserver qui rend accessible mon minicpan via une interface web, je je vous en avais déjà parlé précédemment.

Il y a quelques jours, j'avais expliqué que le sujet de ma gymnastique de l'esprit portait sur l'interrogation d'une base de données SQL via une requête de type moteur de recherche. Mes premiers pas portaient sur l'analyse de la requête en vue de la création d'une structure de données représentant cette requête. J'avais cité CQL::Parser comme exemple pour l'analyse syntaxique d'un requête. Dans l'exercice du jour, je ne ferai que visualiser la structure de données créée par CQL::Parser. Pour la visulisation d'un arbre, je ne connais rien de mieux que Graphviz. Perl offre également une interface à ce programme : GraphViz.

Donc, voici le programme :

#!/usr/bin/env perl

use strict;
use warnings;

use CQL::Parser;
use GraphViz;
use Term::ANSIColor;
use UNIVERSAL;

my $query    = shift;
my $filename = shift;

my $root;

eval { $root = CQL::Parser->new()->parse($query) };
if ($@) {
    die colored(['red'], "We've got some problems: $@"), $/;
}

my $gv = GraphViz->new( layout => 'dot', node => { shape => 'box' } );

traverse( $root, $gv );

open my $fh, '>', $filename;
print $fh $gv->as_png();
close $fh;

sub traverse {
    my ( $node, $gv, $parent ) = @_;

    if ( $node->isa('CQL::BooleanNode') ) {
        $gv->add_node( $node, label => $node->op );
        traverse( $node->left(),  $gv, $node );
        traverse( $node->right(), $gv, $node );
        $gv->add_edge( $parent => $node ) if defined $parent;
    }
    elsif ( $node->isa('CQL::TermNode') ) {
        if ( defined $node->getQualifier ) {
            $gv->add_node( $node->getQualifier, label => $node->getQualifier );
            $gv->add_node( $node->getRelation,
                label => $node->getRelation()->getBase() );
            $gv->add_node( $node, label => $node->getTerm() );
            $gv->add_edge( $node->getQualifier => $node->getRelation );
            $gv->add_edge( $node->getQualifier => $node );
            $gv->add_edge( $parent => $node->getQualifier ) if defined $parent;
        }
        else {
            $gv->add_node( $node, label => $node->getTerm() );
            $gv->add_edge( $parent => $node ) if defined $parent;
        }
    }
    else {
        print colored['green'], ref($node), $/; # cela m'aide à découvrir ce qui n'est pas actuellement géré par la fonction traverse()
    }
}

Le but du programme était juste de me refamiliariser avec le parcours d'arbre, et donc, il n'exploite probablement pas toutes les subtilités de l'analyse de CQL::Parser.

Voici quelques exemples de requêtes et des arbres correspondants :

Bon, ce n'est pas grand chose, mais cela m'a déjà permis de lire le code de CQL::Parser et de réfléchir succinctement à la structure de données créée par ce dernier.

J'ai découvert dernièrement un outil assez utile dans une veille, Instapaper. Comme le dit sa tagline : « A simple tool to save web pages for reading later ». Comme beaucoup de ces outils web, il offre un bookmarlet permettant d'intégrer son usage à notre navigateur web, mais quid lorsque l'on n'utilise pas un navigateur ? Et bien, comme beaucoup de ces outils web (mais pas tous), une API est disponible pour interagir avec ce service web.

Comme j'utilise régulièrement Twitter pour faire ma veille, et que j'utilise twittering-mode pour parcourir mes tweets, j'ai donc besoin d'un outil permettant de faire le lien entre emacs et Instapaper. Je suis encore largement un débutant avec elisp, j'ai donc préféré faire le boulot avec Perl.

La première étape a donc consisté à créer un module : WebService::Instapaper. La documentation officielle de l'API explique les grandes lignes du fonctionnement du module, et le code est plutôt facile à comprendre :

use strict;
use warnings;

package WebService::Instapaper;

use LWP::UserAgent;
use Carp;
use URI;
use URI::QueryParam;

=head1 VERSION

=cut

# ABSTRACT: turns baubles into trinkets

our $VERSION = '0.01';

use constant INSTAPAPER_URI => 'https://www.instapaper.com/api/add';

sub new {
    my ( $class, %attr ) = @_;

    my $self = {};
    $self->{username} = $attr{username} || "";
    $self->{password} = $attr{password} || "";

    $self->{_ua} = LWP::UserAgent->new(
        agent   => 'WebService::Instapaper/0.1',
        cookie  => {},
        timeout => 30,
    );

    bless $self, $class;
}

sub username {
    my ( $self, $username ) = @_;

    $self->{username} = $username;
}

sub password {
    my ( $self, $password ) = @_;

    $self->{password} = $password;
}

sub credentials {
    my ( $self, $username, $password ) = @_;

    $self->username($username);
    $self->password($password);
}

sub add {
    my ( $self, %params ) = @_;

    croak "No username!" unless $self->{username} ne "";
    croak "No URI to read_later!" unless exists $params{url};

    my $uri = URI->new(INSTAPAPER_URI);
    $uri->query_param( url => $params{url} );

    my $request = HTTP::Request->new( GET => $uri, );
    $request->authorization_basic( $self->{username}, $self->{password} );

    my $response = $self->{_ua}->request($request);

    $self->{_last_code}    = $response->code();
    $self->{_last_message} = $response->message();

    if ( $response->code() == 201 ) {
        return 1;
    }
    else {
        return 0;
    }
}

sub message {
    my ($self) = @_;

    return $self->{_last_message} if exists $self->{_last_message};
}

sub code {
    my ($self) = @_;

    return $self->{_last_code} if exists $self->{_last_code};
}

1;

Le module n'est pas encore disponible sur CPAN, mais le dépôt git est disponible via Github.

Après avoir programmer ce module, j'ai donc écrit un script permettant d'ajouter des liens à mon compte Instapaper. Voici le code :

#!/usr/bin/env perl

use strict;
use warnings;

use WebService::Instapaper;

use Getopt::Long;
use Config::INI::Reader;
use File::Spec;

my $config = { config => File::Spec->catfile( $ENV{HOME}, '.instapaperrc' ), };

my $ini_config = Config::INI::Reader->read_file( $config->{config} );

my $reader = WebService::Instapaper->new(
    username => $ini_config->{Instapaper}->{username},
    password => $ini_config->{Instapaper}->{password},
);

GetOptions( $config, 'url=s', 'config=s' );

die "Usage: $0 --url http://www.perl.org\n" unless exists $config->{url};

if ( $reader->add( url => $config->{url} ) ) {
    print "The url (" . $config->{url} . ") has been added successfully.";
}
else {
    print "We received the following error: ("
      . $reader->code . ") "
      . $reader->message;
}

Ce script, nommé read_later.pl, s'appuie sur un fichier de configuration pour trouver les informations nécessaires pour se connecter à Instapaper et utiliser le service. Ce script se trouve évidemment dans mon $PATH.

La dernière partie de l'exercice consiste donc à écrire un peu d'elisp pour dire emacs ce qu'il doit faire. Voici le code :

(defun read-later (url &optional new-window)
  "Use a local script to add an url to the Instapaper website."
  (interactive (browse-url-interactive-arg "Read Later: "))
  (message (shell-command-to-string (concat "read_later.pl " "--url " url))))

Je peux donc maintenant faire M-x read-later, saisir le lien (et si mon curseur se trouve sur un lien, browse-url-interactive-arg se charge de me faciliter le travail), et appuyer sur Enter pour lancer l'ajout du lien. Il ne reste plus qu'à choisir un raccourci clavier pour qu'à partir de twittering-mode, je puisse lancer mon script :

(define-key twittering-mode-map (kbd "R") 'read-later)

Et voilà !!!

Il y a quelques mois, j'ai eu l'occasion de programmer un outil permettant de scruter un réseau, et de donner les adresses IP les plus actives en terme de consommation de la bande passante (en fait, il donne toutes les adresses IP scrutées et pour chaque adresse IP, le nombre de bytes lié à cette adresse). C'est donc relativement naïf comme outil, et cela n'avait pas d'autres buts que de me donner une idée générale de ce qui se passait sur le réseau.

Voici le script :

#!/usr/bin/env perl

use strict;
use warnings;

use Net::Pcap;
use NetPacket::Ethernet qw( :ALL );
use NetPacket::IP;
use DB_File;

my ( $err, $netaddr, $netmask );
my $dev = shift || 'eth0';
my $stat_filename = shift || './stats.db';

tie my %stats, 'DB_File', $stat_filename, O_RDWR|O_CREAT, 0666, $DB_HASH;
$SIG{INT} = \&clean;

die "You need to be root to run this script...\n" if $> != 0;

Net::Pcap::lookupnet( $dev, \$netaddr, \$netmask, \$err) and die "lookupnet $dev failed ($!)\n";
my $object = Net::Pcap::open_live( $dev, 1024, 1, 0, \$err );

Net::Pcap::loop( $object, -1, \&callback, [ $netaddr, $netmask ] );

sub callback {
    my ( $user_data, $header, $raw_packet ) = @_;
    my ( $netaddr, $netmask ) = @{ $user_data };
    
    my $packet = NetPacket::Ethernet->decode( $raw_packet );
    if ($packet->{type} == ETH_TYPE_IP) {
        my $ip = NetPacket::IP->decode( eth_strip($raw_packet) );
        $stats{ $ip->{src_ip} } = 0 if not exists $stats{ $ip->{src_ip} };
        $stats{ $ip->{dest_ip} } = 0 if not exists $stats{ $ip->{dest_ip} };
        
        $stats{ $ip->{src_ip} } += $ip->{len};
        $stats{ $ip->{dest_ip} } += $ip->{len};
    }
}

sub clean {
    my ( $signal ) = @_;
    
    foreach my $key (sort { $stats{$a} <=> $stats{$b} } keys %stats) {
        print $key, ': ', $stats{$key}, $/;
    }

    untie %stats;
    Net::Pcap::close( $object );
}

Alors, ce script emploie le librairie pcap via Net::Pcap pour analyser ce qui se passe sur le réseau, et NetPacket pour décoder les paquets intéressants. J'utilise DB_File pour lier un hash à un fichier (ce qui me permet de stocker l'analyse et de pouvoir réutiliser les résultats ultérieurement). Et finalement, je capture le signal INT de manière à afficher le résultat de l'analyse, et de quitter proprement le programme.

Bref, rien d'exceptionnel, mais toujours utile.

Hier, je vous ai parlé de Clipboard, un module permettant d'accéder au presse-papier de votre système d'exploitation. Aujourd'hui, je vais compléter ces informations avec quelques subtilités concernant l'utilisation de Clipboard sous Linux.

Alors que Clipboard utilise les outils natifs sous Windows et Mac OS X, il s'appuie sur un petit utilitaire sous Linux. Cet utilitaire, xclip, permet de manipuler le contenu des presse-papier sous X11, et oui, vous avez bien lu, j'ai bien écrit le contenu des presse-papier. Car sous X11, nous en avons plusieurs à disposition, et ceci ne va pas sans poser quelques problèmes à l'occasion.

Dans la page de documentation d'xclip, on nous explique qu'il y a trois presse-papier disponibles :

1. primary, utilisé par défaut, donc, quand vous sélectionnez du texte sous X11, il est automatiquement copié dans ce presse-papier, et vous pouvez y accéder via un clic du troisième bouton de votre souris (et si votre souris n'a pas de troisième bouton, vous pouvez l'émuler ; par exemple, par le clic simultané du clic gauche et du clic droit) ;
2. secondary, ce qui est cohérent avec l'existence d'un primary ;
3. clipboard, qui est employé par votre window manager, et donc, par exemple sous Gnome, ce qui est copié via Ctrl-c et collé via Ctrl-v.

Dans un des outils développés accédant au presse-papier pour trouver les informations à traiter, je préférais utiliser le clipboard plutôt que le primary (j'utilise ce script quotidiennement, et sur des machines n'ayant pas toujours une souris externe, et la combinaison clic gauche/clic droit est parfois irritante sur certains trackpads). J'ai donc été lire le module et j'ai constaté qu'une gestion des différents presse-papier avait été mise en place :

• une méthode paste_from_selection() permettant de prendre l'information à partir d'un des presse-papier à disposition ;
• une méthode copy_to_selection() permettant de copier de l'information vers un presse-papier particulier.

Je pouvais donc travailler de la manière suivante :

  #!/usr/bin/env perl
  
  use strict;
  use warnings;
  
  use Clipboard;
  
  my $text = Clipboard::Xclip->paste_from_selection('clipboard'); # pour récupérer le texte du presse-papier
  
  Clipboard::Xclip->copy_to_selection('clipboard', 'Balh blah blah'); # pour coller du texte dans le presse-papier

Malheureusement, j'utilise ces scripts également avec Windows et Mac OS X, il était donc hors de question d'avoir des appels directs à paste_from_selection() ou copy_to_selection(). Il me restait donc la solution de tester $^O pour connaître mon environnement d'exécution et adapter le comportement de mon programme en fonction, ou alors utiliser le hack suivant.

Dans Clipboard::Xclip, une autre méthode est définie pour définir le presse-papier favori, cette méthode s'appelle favorite_selection(), dont voici la définition :

  sub favorite_selection { ($self->all_selections)[0] } # retourne le premier presse-papier disponible, donc primary
  
  sub all_selections { qw(primary buffer clipboard secondary) } # liste les presse-papier disponibles

Il me suffit donc de redéfinir la fonction favorite_selection() pour lui faire sélectionner mon presse-papier favori. Voici donc le code :

  undef &Clipboard::Xclip::favorite_selection; # on « supprime » la définition de la méthode favorite_selection
  *Clipboard::Xclip::favorite_selection = sub { 'clipboard' }; # on redéfinit l'action de la méthode

Et maintenant, je peux continuer à utiliser Clipboard->paste() et Clipboard->copy() sans me soucier du reste !

Si certains ont défini les programmes informatiques comme étant l'addition d'un algorithme et d'une structure de données, force est de constater que les programmes ne sont pas fort utiles si nous ne pouvons pas leur donner des informations (via des entrées) et s'ils ne peuvent pas nous rendre les résultats des traitements effectués (via les sorties).

Comme la majorité des programmes que j'écris en Perl rentre dans la catégorie des outils censés me rendre la vie plus facile, cette notion d'entrées-sorties prend une importance particulière. Ainsi, j'ai un outil qui transforme un ISBN en une référence bibliographique au format BibTeX (en fait, j'ai plusieurs déclinaisons de cet outil, mais passons !), je dois donc transmettre l'ISBN à mon programme et je dois récupérer la notice au format BibTeX, l'idéal est donc de travailler sur base du presse-papier, je copie l'ISBN, je lance le programme, et, finalement, je peux coller ma notice BibTeX là où bon me semble.

Pour accéder au presse-papier via Perl, nous avons un module nommé Clipboard, ce module est rigoureusement simple dans son utilisation, et terriblement utile puisqu'il est multi-plateforme (enfin, il permet d'utiliser de manière transparente de presse-papier sur Windows, Mac OS X et Linux).

Voici un exemple d'utilisation :

#!/usr/bin/env perl

use strict;
use warnings;

use Clipboard;

print Clipboard->paste; # nous accédons à ce qui a été copié dans le presse-papier

Clipboard->copy( scalar localtime ); # nous copions la date du jour dans le presse-papier

Rien de sorcier donc ! Et indispensable pour intégrer mes programmes facilement dans mon informatique quotidienne.

Régulièrement, je me soumet à une forme de gymnastique de l'esprit. Cette gymnastique consiste à trouver un thème qui m'intéresse, et de le travailler brièvement. Si le sujet est informatique, il s'agira pour moi de programmer une implémentation naïve ; sinon, de rédiger une courte synthèse. L'objectif de cette gymnastique étant de m'obliger à manipuler des notions, qu'elles soient connues ou non, pour mieux les intégrer et les comprendre.

Hier, cette gymnastique a commencé par une réflexion sur l'analyse de requêtes telles que celles soumises à un moteur de recherche et la soumission de ces dernières à un moteur SQL. Bon, le sujet étant assez vaste, je me suis d'abord intéressé à l'analyse syntaxique d'une requête. J'ai été tout naturellement sur le CPAN pour voir les modules existants, et ainsi lire les implémentations actuelles. Je me suis penché plus particulièrement sur deux modules :

1. Search::QueryParser écrit par Laurent Dami, et
2. CQL::Parser écrit par Brian Cassidy.

Ces deux modules analysent tout les deux des requêtes, mais la forme des requêtes est différentes, le premier analyse des requêtes « à la Google » et le second est spécialisé dans les requêtes CQL (CQL signifiant Common Query Language). Les détails d'implémentation sont également différents :

• Search::QueryParser n'utilise pas de tokenizer externe et travaille donc de la manière suivante : une boucle dont le paramètre est la requête, et des appels successifs à s/// permet de raccourcir cette requête jusqu'à son analyse complète. J'aime bien cette approche pour construire rapidement un analyseur syntaxique de requêtes simples. Par contre, quand le langage de requête devient plus complexe, je crains que cela ne devienne un peu laborieux à maintenir ;
• CQL::Parser quant à lui s'appuie sur un tokenizer externe : String::Tokenizer. Ce dernier traduit une chaîne de caractères en un tableau, il « suffira » de traduire ce tableau de manière à interroger le système d'information de notre choix (SGBD, moteur de recherche, etc) ; j'ai lu rapidement la documentation de String::Tokenizer, et c'est définitivement un module que je rajouterai dans mon Top 100.

Du côté de l'implémentation naïve, j'ai essentiellement joué avec la méthode adoptée par Search::QueryParser. Je me suis contenté de créer un arbre d'une expression arithmétique. Et c'est tellement naïf que je n'ai même pas valider l'expression arithmétique. Au niveau de la création de l'arbre, j'ai utilisé un autre module de mon Top 100, à savoir Tree::DAG_Node. Voici le code produit :

#!/usr/bin/env perl

use strict;
use warnings;
use diagnostics;

use Tree::DAG_Node;

my $query = shift || '+ 1 2';
my $root;
my $lastnode;

while ($query) {
    if ($query =~ s/^(\+)\s*(\w*)/$2/) {
        if (not defined $root) {
            $root = Tree::DAG_Node->new();
            $root->name( $1 );
            $lastnode = $root;
        } else {
            my $node = Tree::DAG_Node->new();
            $node->name( $1 );
            $lastnode->add_daughter( $node );
            $lastnode = $node;
        }
    } elsif ($query =~ s/^(\d+)\s*(\w*)/$2/) {
        my $daughter = $lastnode->new_daughter;
        $daughter->name( $1 );
    }
}


my $diagram = $root->draw_ascii_tree;
print map "$_\n", @$diagram;

Il reste encore du chemin avant de traduire un

dc.title any rose and dc.creator = eco

en

SELECT * FROM books WHERE books.title LIKE '%rose%' and author LIKE '%eco%'

Mais chaque chose en son temps, et le CPAN est plein de modules qui me serviront de boussole pour terminer cette promenade.