AUTOLOAD: Captura de LLamadas

En la mayor parte de los lenguajes de programación, si se llama a una subrutina que no existe se produce inmediatamente un error. Perl proporciona un medio para crear una rutina ''captura-llamadas'' para cada paquete, la cuál será llamada siempre que la rutina solicitada no exista. Su nombre debe ser AUTOLOAD. Los parámetros que se le pasan a dicha subrutina serán los mismos que se pasaron a la subrutina desaparecida. Cuando se invoca a AUTOLOAD, la variable (del paquete) $AUTOLOAD contiene el nombre de la rutina solicitada. De este modo es posible conocer que rutina intentaba invocar el programa usuario.

Jerarquía de Ficheros

La jerarquía de directorios de nuestra aplicación es:

lhp@nereida:~/Lperl/src/systemcommand$ pwd
/home/lhp/Lperl/src/systemcommand
lhp@nereida:~/Lperl/src/systemcommand$ tree
.
|-- lib
|   `-- System
|       `-- Commands.pm
`-- script
    `-- usesystemcommand.pl

3 directories, 2 files

El Módulo

El módulo System::Commands proporciona una interfaz funcional a los comandos del sistema operativo:

lhp@nereida:~/Lperl/src/systemcommand$ cat -n lib/System/Commands.pm
 1  package System::Commands;
 2  use warnings;
 3  use strict;
 4  use File::Which qw(which);
 5  use List::Util qw{first};
 6
 7  my @ALLOWED;
 8
 9  our $AUTOLOAD;
10  sub AUTOLOAD {
11    $AUTOLOAD =~ m{.*::(\w+)$};
12    my $command = $1;
13
14    die "Error! sub $AUTOLOAD does not exists!\n" unless first { $command eq $_ } @ALLOWED;
15    no strict 'refs';
16    *{$AUTOLOAD} = sub {
17      return `$command @_`;
18    };
19
20    goto &{$AUTOLOAD};
21
22  }
23
24  sub import {
25    my $mypackage = shift;
26    push @ALLOWED, @_;
27
28    my ($caller_package) = caller;
29    {
30      no strict 'refs';
31      for my $command (@_) {
32        # Comprobar si existe el comando
33        die "Error! '$command' command does not exists!\n" unless which($command);
34        *{$caller_package."::".$command} = \&{$command};
35      }
36    }
37  }
38
39  1;

El Cliente

Veamos el programa cliente:

lhp@nereida:~/Lperl/src/systemcommand$ cat -n script/usesystemcommand.pl
 1  #!/usr/bin/perl -I../lib -w
 2  use strict;
 3  use System::Commands qw{ls};
 4
 5  my $f = shift || 'pe*.pl';
 6
 7  print "\n******Contexto de lista*********\n";
 8  my @files = ls("-l", "-t", "-r", $f);
 9  print @files;
10
11  print "\n******Contexto escalar*********\n";
12  my $files = ls("-l", "-t", "-r", $f);
13  print $files;
14
15  print "\n******No existe*********\n";
16  my @r = chuchu("a");

Ejecución

Sigue una ejecución:

lhp@nereida:~/Lperl/src/systemcommand$ cd script/
lhp@nereida:~/Lperl/src/systemcommand/script$ usesystemcommand.pl

******Contexto de lista*********
ls: pe*.pl: No existe el fichero o el directorio

******Contexto escalar*********
ls: pe*.pl: No existe el fichero o el directorio

******No existe*********
Undefined subroutine &main::chuchu called at ./usesystemcommand.pl line 16.

Clausura y Memoria

La siguiente sesión con el depurador muestra el interés de la línea

   push @ALLOWED, @_;

y de tener @ALLOWED declarada como una variable léxica en el ámbito del fichero:

lhp@nereida:~/Lperl/src/systemcommand/script$ perl -wde 0
main::(-e:1):   0
  DB<1> push @INC, '../lib'
  DB<2> use System::Commands qw{ls}
  DB<3> x ls('*.pl')
0  'usesystemcommand.pl
'
  DB<4> use System::Commands qw{ps}
  DB<5> p ps
  PID TTY          TIME CMD
 1632 pts/18   00:00:00 su
 1633 pts/18   00:00:00 bash
20981 pts/18   00:00:00 perl
20988 pts/18   00:00:00 ps
  DB<6> p ls
usesystemcommand.pl
  DB<7> p echo('Good morning')
Undefined subroutine &main::echo called at (eval 15)[/usr/share/perl/5.8/perl5db.pl:628] line 2.