Filtros para DBM

Es posible añadir un filtro que procese los accesos a un DBM. Podemos definir una subrutina que es llamada cada vez que almacenamos un valor en el hash DBM y otra que sea llamada cada vez que se lee una entrada del hash DBM.

El formato general de uso es:

   $db = tie %hash, 'DBM', ...

   $old_filter = $db->filter_store_key  ( sub { ... } );
   $old_filter = $db->filter_store_value( sub { ... } );
   $old_filter = $db->filter_fetch_key  ( sub { ... } );
   $old_filter = $db->filter_fetch_value( sub { ... } );

Usando estos filtros podemos serializar valores del hash que sean estructuras de datos complejas. En el siguiente código el hash DBM %h contiene como valores referencias a cadenas. El filtro vuelca con Data::Dumper el valor complejo y lo comprime usando la función compress del módulo Compress::Zlib . El proceso inverso consiste en descomprimir y evaluar:

$ cat -n  dbwithfilter.pl
 1  #!/usr/bin/perl
 2  use warnings;
 3  use Compress::Zlib;
 4  use DB_File;
 5  use Data::Dumper;
 6
 7  unlink 'mldbmtest.dat';
 8
 9  $h = tie my %db1, 'DB_File', 'mldbmtest.dat', O_CREAT | O_RDWR, 0666
10      or die "No se pudo inicializar el fichero MLDBM: $!\n";
11
12  $h->filter_store_value(sub { $_ = compress(Dumper($_)) });
13  $h->filter_fetch_value(sub { $_ = eval(uncompress($_)) });
14
15  %db1 = (
16      'alu2511' => [ 'a'x30 ],
17      'alu2233' => [ 'b'x30 ]
18  );
19
20  print Data::Dumper->Dump( [ \%db1 ] );

Este otro programa lee el hash DBM creado por el programa anterior:

$ cat -n dbwithfilterretrieve.pl
 1  #!/usr/bin/perl
 2  use warnings;
 3  use Compress::Zlib;
 4  use DB_File;
 5  use Data::Dumper;
 6
 7  my $h = tie my %db2, 'DB_File', 'mldbmtest.dat', O_RDWR, 0666
 8      or die "No se pudo leer el fichero MLDBM: $!\n";
 9  $h->filter_store_value(sub { $_ = compress(Dumper($_)) });
10  $h->filter_fetch_value(sub { $_ = eval(uncompress($_)) });
11
12  print Data::Dumper->Dump( [ \%db2 ] );

Cuando se ejecutan estos dos programas obtenemos la siguiente salida:

$ dbwithfilter.pl
$VAR1 = {
          'alu2233' => [ 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb' ],
          'alu2511' => [ 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' ]
        };
lhp@nereida:~/Lperl/src$ dbwithfilterretrieve.pl
$VAR1 = {
          'alu2233' => [ 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb' ],
          'alu2511' => [ 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' ]
        };