home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _c0f63d786a44205b9d81181e1582e895 < prev    next >
Encoding:
Text File  |  2004-04-13  |  17.7 KB  |  547 lines
  1. package Tie::Watch;
  2.  
  3. use vars qw($VERSION);
  4. $VERSION = '3.002'; # $Id: //depot/Tk8/lib/Tie/Watch.pm#2 $
  5.  
  6. =head1 NAME
  7.  
  8.  Tie::Watch - place watchpoints on Perl variables.
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.  use Tie::Watch;
  13.  
  14.  $watch = Tie::Watch->new(
  15.      -variable => \$frog,
  16.      -debug    => 1,
  17.      -shadow   => 0,            
  18.      -fetch    => [\&fetch, 'arg1', 'arg2', ..., 'argn'],
  19.      -store    => \&store,
  20.      -destroy  => sub {print "Final value=$frog.\n"},
  21.  }
  22.  %vinfo = $watch->Info;
  23.  $args  = $watch->Args(-fetch);
  24.  $val   = $watch->Fetch;
  25.  print "val=", $watch->Say($val), ".\n";
  26.  $watch->Store('Hello');
  27.  $watch->Unwatch;
  28.  
  29. =head1 DESCRIPTION
  30.  
  31. This class module binds one or more subroutines of your devising to a
  32. Perl variable.  All variables can have B<FETCH>, B<STORE> and
  33. B<DESTROY> callbacks.  Additionally, arrays can define B<CLEAR>, B<EXTEND>,
  34. B<FETCHSIZE>, B<POP>, B<PUSH>, B<SHIFT>, B<SPLICE>, B<STORESIZE> and
  35. B<UNSHIFT> callbacks, and hashes can define B<CLEAR>, B<DELETE>, B<EXISTS>,
  36. B<FIRSTKEY> and B<NEXTKEY> callbacks.  If these term are unfamiliar to you,
  37. I I<really> suggest you read L<perltie>.
  38.  
  39. With Tie::Watch you can:
  40.  
  41.  . alter a variable's value
  42.  . prevent a variable's value from being changed
  43.  . invoke a Perl/Tk callback when a variable changes
  44.  . trace references to a variable
  45.  
  46. Callback format is patterned after the Perl/Tk scheme: supply either a
  47. code reference, or, supply an array reference and pass the callback
  48. code reference in the first element of the array, followed by callback
  49. arguments.  (See examples in the Synopsis, above.)
  50.  
  51. Tie::Watch provides default callbacks for any that you fail to
  52. specify.  Other than negatively impacting performance, they perform
  53. the standard action that you'd expect, so the variable behaves
  54. "normally".  Once you override a default callback, perhaps to insert
  55. debug code like print statements, your callback normally finishes by
  56. calling the underlying (overridden) method.  But you don't have to!
  57.  
  58. To map a tied method name to a default callback name simply lowercase
  59. the tied method name and uppercase its first character.  So FETCH
  60. becomes Fetch, NEXTKEY becomes Nextkey, etcetera.
  61.  
  62. Here are two callbacks for a scalar. The B<FETCH> (read) callback does
  63. nothing other than illustrate the fact that it returns the value to
  64. assign the variable.  The B<STORE> (write) callback uppercases the
  65. variable and returns it.  In all cases the callback I<must> return the
  66. correct read or write value - typically, it does this by invoking the
  67. underlying method.
  68.  
  69.  my $fetch_scalar = sub {
  70.      my($self) = @_;
  71.      $self->Fetch;
  72.  };
  73.  
  74.  my $store_scalar = sub {
  75.      my($self, $new_val) = @_;
  76.      $self->Store(uc $new_val);
  77.  };
  78.  
  79. Here are B<FETCH> and B<STORE> callbacks for either an array or hash.
  80. They do essentially the same thing as the scalar callbacks, but
  81. provide a little more information.
  82.  
  83.  my $fetch = sub {
  84.      my($self, $key) = @_;
  85.      my $val = $self->Fetch($key);
  86.      print "In fetch callback, key=$key, val=", $self->Say($val);
  87.      my $args = $self->Args(-fetch);
  88.      print ", args=('", join("', '",  @$args), "')" if $args;
  89.      print ".\n";
  90.      $val;
  91.  };
  92.  
  93.  my $store = sub {
  94.      my($self, $key, $new_val) = @_;
  95.      my $val = $self->Fetch($key);
  96.      $new_val = uc $new_val;
  97.      $self->Store($key, $new_val);
  98.      print "In store callback, key=$key, val=", $self->Say($val),
  99.        ", new_val=", $self->Say($new_val);
  100.      my $args = $self->Args(-store);
  101.      print ", args=('", join("', '",  @$args), "')" if $args;
  102.      print ".\n";
  103.      $new_val;
  104.  };
  105.  
  106. In all cases, the first parameter is a reference to the Watch object,
  107. used to invoke the following class methods.
  108.  
  109. =head1 METHODS
  110.  
  111. =over 4
  112.  
  113. =item $watch = Tie::Watch->new(-options => values);
  114.  
  115. The watchpoint constructor method that accepts option/value pairs to
  116. create and configure the Watch object.  The only required option is
  117. B<-variable>.
  118.  
  119. B<-variable> is a I<reference> to a scalar, array or hash variable.
  120.  
  121. B<-debug> (default 0) is 1 to activate debug print statements internal
  122. to Tie::Watch.
  123.  
  124. B<-shadow> (default 1) is 0 to disable array and hash shadowing.  To
  125. prevent infinite recursion Tie::Watch maintains parallel variables for
  126. arrays and hashes.  When the watchpoint is created the parallel shadow
  127. variable is initialized with the watched variable's contents, and when
  128. the watchpoint is deleted the shadow variable is copied to the original
  129. variable.  Thus, changes made during the watch process are not lost.
  130. Shadowing is on my default.  If you disable shadowing any changes made
  131. to an array or hash are lost when the watchpoint is deleted.
  132.  
  133. Specify any of the following relevant callback parameters, in the
  134. format described above: B<-fetch>, B<-store>, B<-destroy>.
  135. Additionally for arrays: B<-clear>, B<-extend>, B<-fetchsize>,
  136. B<-pop>, B<-push>, B<-shift>, B<-splice>, B<-storesize> and
  137. B<-unshift>.  Additionally for hashes: B<-clear>, B<-delete>,
  138. B<-exists>, B<-firstkey> and B<-nextkey>.
  139.  
  140. =item $args = $watch->Args(-fetch);
  141.  
  142. Returns a reference to a list of arguments for the specified callback,
  143. or undefined if none.
  144.  
  145. =item $watch->Fetch();  $watch->Fetch($key);
  146.  
  147. Returns a variable's current value.  $key is required for an array or
  148. hash.
  149.  
  150. =item %vinfo = $watch->Info();
  151.  
  152. Returns a hash detailing the internals of the Watch object, with these
  153. keys:
  154.  
  155.  %vinfo = {
  156.      -variable =>  SCALAR(0x200737f8)
  157.      -debug    =>  '0'
  158.      -shadow   =>  '1'
  159.      -value    =>  'HELLO SCALAR'
  160.      -destroy  =>  ARRAY(0x200f86cc)
  161.      -fetch    =>  ARRAY(0x200f8558)
  162.      -store    =>  ARRAY(0x200f85a0)
  163.      -legible  =>  above data formatted as a list of string, for printing
  164.  }
  165.  
  166. For array and hash Watch objects, the B<-value> key is replaced with a
  167. B<-ptr> key which is a reference to the parallel array or hash.
  168. Additionally, for an array or hash, there are key/value pairs for
  169. all the variable specific callbacks.
  170.  
  171. =item $watch->Say($val);
  172.  
  173. Used mainly for debugging, it returns $val in quotes if required, or
  174. the string "undefined" for undefined values.
  175.  
  176. =item $watch->Store($new_val);  $watch->Store($key, $new_val);
  177.  
  178. Store a variable's new value.  $key is required for an array or hash.
  179.  
  180. =item $watch->Unwatch();
  181.  
  182. Stop watching the variable.
  183.  
  184. =back
  185.  
  186. =head1 EFFICIENCY CONSIDERATIONS
  187.  
  188. If you can live using the class methods provided, please do so.  You
  189. can meddle with the object hash directly and improved watch
  190. performance, at the risk of your code breaking in the future.
  191.  
  192. =head1 AUTHOR
  193.  
  194. Stephen.O.Lidie@Lehigh.EDU
  195.  
  196. =head1 HISTORY
  197.  
  198.  lusol@Lehigh.EDU, LUCC, 96/05/30
  199.  . Original version 0.92 release, based on the Trace module from Hans Mulder,
  200.    and ideas from Tim Bunce.
  201.  
  202.  lusol@Lehigh.EDU, LUCC, 96/12/25
  203.  . Version 0.96, release two inner references detected by Perl 5.004.
  204.  
  205.  lusol@Lehigh.EDU, LUCC, 97/01/11
  206.  . Version 0.97, fix Makefile.PL and MANIFEST (thanks Andreas Koenig).
  207.    Make sure test.pl doesn't fail if Tk isn't installed.
  208.  
  209.  Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 97/10/03
  210.  . Version 0.98, implement -shadow option for arrays and hashes.
  211.  
  212.  Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 98/02/11
  213.  . Version 0.99, finally, with Perl 5.004_57, we can completely watch arrays.
  214.    With tied array support this module is essentially complete, so its been
  215.    optimized for speed at the expense of clarity - sorry about that. The
  216.    Delete() method has been renamed Unwatch() because it conflicts with the
  217.    builtin delete().
  218.  
  219.  Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 99/04/04
  220.  . Version 1.0, for Perl 5.005_03, update Makefile.PL for ActiveState, and
  221.    add two examples (one for Perl/Tk).
  222.  
  223. =head1 COPYRIGHT
  224.  
  225. Copyright (C) 1996 - 1999 Stephen O. Lidie. All rights reserved.
  226.  
  227. This program is free software; you can redistribute it and/or modify it under
  228. the same terms as Perl itself.
  229.  
  230. =cut
  231.  
  232. use 5.004_57;
  233. use Carp;
  234. use strict;
  235. use subs qw/normalize_callbacks/;
  236. use vars qw/@array_callbacks @hash_callbacks @scalar_callbacks/;
  237.  
  238. @array_callbacks  = qw/-clear -destroy -extend -fetch -fetchsize -pop -push
  239.                        -shift -splice -store -storesize -unshift/;
  240. @hash_callbacks   = qw/-clear -delete -destroy -exists -fetch -firstkey
  241.                        -nextkey -store/;
  242. @scalar_callbacks = qw/-destroy -fetch -store/;
  243.  
  244. sub new {
  245.  
  246.     # Watch constructor.  The *real* constructor is Tie::Watch->base_watch(),
  247.     # invoked by methods in other Watch packages, depending upon the variable's
  248.     # type.  Here we supply defaulted parameter values and then verify them,
  249.     # normalize all callbacks and bind the variable to the appropriate package.
  250.  
  251.     my($class, %args) = @_;
  252.     my $version = $Tie::Watch::VERSION;
  253.     my (%arg_defaults) = (-debug => 0, -shadow  => 1);
  254.     my $variable = $args{-variable};
  255.     croak "Tie::Watch::new(): -variable is required." if not defined $variable;
  256.  
  257.     my($type, $watch_obj) = (ref $variable, undef);
  258.     if ($type =~ /SCALAR/) {
  259.     @arg_defaults{@scalar_callbacks} = (
  260.         [\&Tie::Watch::Scalar::Destroy],  [\&Tie::Watch::Scalar::Fetch],
  261.         [\&Tie::Watch::Scalar::Store]);
  262.     } elsif ($type =~ /ARRAY/) {
  263.     @arg_defaults{@array_callbacks}  = (
  264.         [\&Tie::Watch::Array::Clear],     [\&Tie::Watch::Array::Destroy],
  265.         [\&Tie::Watch::Array::Extend],    [\&Tie::Watch::Array::Fetch],
  266.         [\&Tie::Watch::Array::Fetchsize], [\&Tie::Watch::Array::Pop],
  267.             [\&Tie::Watch::Array::Push],      [\&Tie::Watch::Array::Shift],
  268.             [\&Tie::Watch::Array::Splice],    [\&Tie::Watch::Array::Store],
  269.             [\&Tie::Watch::Array::Storesize], [\&Tie::Watch::Array::Unshift]);
  270.     } elsif ($type =~ /HASH/) {
  271.     @arg_defaults{@hash_callbacks}   = (
  272.         [\&Tie::Watch::Hash::Clear],      [\&Tie::Watch::Hash::Delete],
  273.         [\&Tie::Watch::Hash::Destroy],    [\&Tie::Watch::Hash::Exists],
  274.             [\&Tie::Watch::Hash::Fetch],      [\&Tie::Watch::Hash::Firstkey],
  275.             [\&Tie::Watch::Hash::Nextkey],    [\&Tie::Watch::Hash::Store]);
  276.     } else {
  277.     croak "Tie::Watch::new() - not a variable reference.";
  278.     }
  279.     my(@margs, %ahsh, $args, @args);
  280.     @margs = grep ! defined $args{$_}, keys %arg_defaults;
  281.     %ahsh = %args;                         # argument hash
  282.     @ahsh{@margs} = @arg_defaults{@margs}; # fill in missing values
  283.     normalize_callbacks \%ahsh;
  284.  
  285.     if ($type =~ /SCALAR/) {
  286.         $watch_obj = tie $$variable, 'Tie::Watch::Scalar', %ahsh;
  287.     } elsif ($type =~ /ARRAY/) {
  288.         $watch_obj = tie @$variable, 'Tie::Watch::Array',  %ahsh;
  289.     } elsif ($type =~ /HASH/) {
  290.         $watch_obj = tie %$variable, 'Tie::Watch::Hash',   %ahsh;
  291.     }
  292.     $watch_obj;
  293.  
  294. } # end new, Watch constructor
  295.  
  296. sub Args {
  297.  
  298.     # Return a reference to a list of callback arguments, or undef if none.
  299.     #
  300.     # $_[0] = self
  301.     # $_[1] = callback type
  302.  
  303.     defined $_[0]->{$_[1]}->[1] ? [@{$_[0]->{$_[1]}}[1 .. $#{$_[0]->{$_[1]}}]]
  304.     : undef;
  305.  
  306. } # end Args
  307.  
  308. sub Info {
  309.  
  310.     # Info() method subclassed by other Watch modules.
  311.     #
  312.     # $_[0] = self
  313.     # @_[1 .. $#_] = optional callback types
  314.  
  315.     my(%vinfo, @results);
  316.     my(@info) = (qw/-variable -debug -shadow/);
  317.     push @info, @_[1 .. $#_] if scalar @_ >= 2;
  318.     foreach my $type (@info) {
  319.     push @results,     sprintf('%-10s: ', substr $type, 1) .
  320.         $_[0]->Say($_[0]->{$type});
  321.     $vinfo{$type} = $_[0]->{$type};
  322.     }
  323.     $vinfo{-legible} = [@results];
  324.     %vinfo;
  325.  
  326. } # end Info
  327.  
  328. sub Say {
  329.  
  330.     # For debugging, mainly.
  331.     #
  332.     # $_[0] = self
  333.     # $_[1] = value
  334.  
  335.     defined $_[1] ? (ref($_[1]) ne '' ? $_[1] : "'$_[1]'") : "undefined";
  336.  
  337. } # end Say
  338.  
  339. sub Unwatch {
  340.  
  341.     # Stop watching a variable by releasing the last reference and untieing it.
  342.     # Update the original variable with its shadow, if appropriate.
  343.     #
  344.     # $_[0] = self
  345.  
  346.     my $variable = $_[0]->{-variable};
  347.     my $type = ref $variable;
  348.     my $copy = $_[0]->{-ptr} if $type !~ /SCALAR/;
  349.     my $shadow = $_[0]->{-shadow};
  350.     undef $_[0];
  351.     if ($type =~ /SCALAR/) {
  352.     untie $$variable;
  353.     } elsif ($type =~ /ARRAY/) {
  354.     untie @$variable;
  355.     @$variable = @$copy if $shadow;
  356.     } elsif ($type =~ /HASH/) {
  357.     untie %$variable;
  358.     %$variable = %$copy if $shadow;
  359.     } else {
  360.     croak "Tie::Watch::Delete() - not a variable reference.";
  361.     }
  362.  
  363. } # end Unwatch
  364.  
  365. # Watch private methods.
  366.  
  367. sub base_watch {
  368.  
  369.     # Watch base class constructor invoked by other Watch modules.
  370.  
  371.     my($class, %args) = @_;
  372.     my $watch_obj = {%args};
  373.     $watch_obj;
  374.  
  375. } # end base_watch
  376.  
  377. sub callback {
  378.  
  379.     # Execute a Watch callback, either the default or user specified.
  380.     # Note that the arguments are those supplied by the tied method,
  381.     # not those (if any) specified by the user when the watch object
  382.     # was instantiated.  This is for performance reasons, and why the
  383.     # Args() method exists.
  384.     #
  385.     # $_[0] = self
  386.     # $_[1] = callback type
  387.     # $_[2] through $#_ = tied arguments
  388.  
  389.     &{$_[0]->{$_[1]}->[0]} ($_[0], @_[2 .. $#_]);
  390.  
  391. } # end callback
  392.  
  393. sub normalize_callbacks {
  394.  
  395.     # Ensure all callbacks are normalized in [\&code, @args] format.
  396.  
  397.     my($args_ref) = @_;
  398.     my($cb, $ref);
  399.     foreach my $arg (keys %$args_ref) {
  400.     next if $arg =~ /variable|debug|shadow/;
  401.     $cb = $args_ref->{$arg};
  402.     $ref = ref $cb;
  403.     if ($ref =~ /CODE/) {
  404.         $args_ref->{$arg} = [$cb];
  405.     } elsif ($ref !~ /ARRAY/) {
  406.         croak "Tie::Watch:  malformed callback $arg=$cb.";
  407.     }
  408.     }
  409.  
  410. } # end normalize_callbacks
  411.  
  412. ###############################################################################
  413.  
  414. package Tie::Watch::Scalar;
  415.  
  416. use Carp;
  417. @Tie::Watch::Scalar::ISA = qw/Tie::Watch/;
  418.  
  419. sub TIESCALAR {
  420.  
  421.     my($class, %args) = @_;
  422.     my $variable = $args{-variable};
  423.     my $watch_obj = Tie::Watch->base_watch(%args);
  424.     $watch_obj->{-value} = $$variable;
  425.     print "WatchScalar new: $variable created, \@_=", join(',', @_), "!\n"
  426.     if $watch_obj->{-debug};
  427.     bless $watch_obj, $class;
  428.  
  429. } # end TIESCALAR
  430.  
  431. sub Info {$_[0]->SUPER::Info('-value', @Tie::Watch::scalar_callbacks)}
  432.  
  433. # Default scalar callbacks.
  434.  
  435. sub Destroy {undef %{$_[0]}}
  436. sub Fetch   {$_[0]->{-value}}
  437. sub Store   {$_[0]->{-value} = $_[1]}
  438.  
  439. # Scalar access methods.
  440.  
  441. sub DESTROY {$_[0]->callback(-destroy)}
  442. sub FETCH   {$_[0]->callback(-fetch)}
  443. sub STORE   {$_[0]->callback(-store, $_[1])}
  444.  
  445. ###############################################################################
  446.  
  447. package Tie::Watch::Array;
  448.  
  449. use Carp;
  450. @Tie::Watch::Array::ISA = qw/Tie::Watch/;
  451.  
  452. sub TIEARRAY {
  453.  
  454.     my($class, %args) = @_;
  455.     my($variable, $shadow) = @args{-variable, -shadow};
  456.     my @copy = @$variable if $shadow; # make a private copy of user's array
  457.     $args{-ptr} = $shadow ? \@copy : [];
  458.     my $watch_obj = Tie::Watch->base_watch(%args);
  459.     print "WatchArray new: $variable created, \@_=", join(',', @_), "!\n"
  460.     if $watch_obj->{-debug};
  461.     bless $watch_obj, $class;
  462.  
  463. } # end TIEARRAY
  464.  
  465. sub Info {$_[0]->SUPER::Info('-ptr', @Tie::Watch::array_callbacks)}
  466.  
  467. # Default array callbacks.
  468.  
  469. sub Clear     {$_[0]->{-ptr} = ()}
  470. sub Destroy   {undef %{$_[0]}}
  471. sub Extend    {}
  472. sub Fetch     {$_[0]->{-ptr}->[$_[1]]}
  473. sub Fetchsize {scalar @{$_[0]->{-ptr}}}
  474. sub Pop       {pop @{$_[0]->{-ptr}}}
  475. sub Push      {push @{$_[0]->{-ptr}}, @_[1 .. $#_]}
  476. sub Shift     {shift @{$_[0]->{-ptr}}}
  477. sub Splice    {
  478.     my $n = scalar @_;        # splice() is wierd!
  479.     return splice @{$_[0]->{-ptr}}, $_[1]                      if $n == 2;
  480.     return splice @{$_[0]->{-ptr}}, $_[1], $_[2]               if $n == 3;
  481.     return splice @{$_[0]->{-ptr}}, $_[1], $_[2], @_[3 .. $#_] if $n >= 4;
  482. }
  483. sub Store     {$_[0]->{-ptr}->[$_[1]] = $_[2]}
  484. sub Storesize {$#{@{$_[0]->{-ptr}}} = $_[1] - 1}
  485. sub Unshift   {unshift @{$_[0]->{-ptr}}, @_[1 .. $#_]}
  486.  
  487. # Array access methods.
  488.  
  489. sub CLEAR     {$_[0]->callback(-clear)}
  490. sub DESTROY   {$_[0]->callback(-destroy)}
  491. sub EXTEND    {$_[0]->callback(-extend, $_[1])}
  492. sub FETCH     {$_[0]->callback(-fetch, $_[1])}
  493. sub FETCHSIZE {$_[0]->callback(-fetchsize)}
  494. sub POP       {$_[0]->callback('-pop')}
  495. sub PUSH      {$_[0]->callback('-push', @_[1 .. $#_])}
  496. sub SHIFT     {$_[0]->callback('-shift')}
  497. sub SPLICE    {$_[0]->callback('-splice', @_[1 .. $#_])}
  498. sub STORE     {$_[0]->callback(-store, $_[1], $_[2])}
  499. sub STORESIZE {$_[0]->callback(-storesize, $_[1])}
  500. sub UNSHIFT   {$_[0]->callback('-unshift', @_[1 .. $#_])}
  501.  
  502. ###############################################################################
  503.  
  504. package Tie::Watch::Hash;
  505.  
  506. use Carp;
  507. @Tie::Watch::Hash::ISA = qw/Tie::Watch/;
  508.  
  509. sub TIEHASH {
  510.  
  511.     my($class, %args) = @_;
  512.     my($variable, $shadow) = @args{-variable, -shadow};
  513.     my %copy = %$variable if $shadow; # make a private copy of user's hash
  514.     $args{-ptr} = $shadow ? \%copy : {};
  515.     my $watch_obj = Tie::Watch->base_watch(%args);
  516.     print "WatchHash new: $variable created, \@_=", join(',', @_), "!\n"
  517.     if $watch_obj->{-debug};
  518.     bless $watch_obj, $class;
  519.  
  520. } # end TIEHASH
  521.  
  522. sub Info {$_[0]->SUPER::Info('-ptr', @Tie::Watch::hash_callbacks)}
  523.  
  524. # Default hash callbacks.
  525.  
  526. sub Clear    {$_[0]->{-ptr} = ()}
  527. sub Delete   {delete $_[0]->{-ptr}->{$_[1]}}
  528. sub Destroy  {undef %{$_[0]}}
  529. sub Exists   {exists $_[0]->{-ptr}->{$_[1]}}
  530. sub Fetch    {$_[0]->{-ptr}->{$_[1]}}
  531. sub Firstkey {my $c = keys %{$_[0]->{-ptr}}; each %{$_[0]->{-ptr}}}
  532. sub Nextkey  {each %{$_[0]->{-ptr}}}
  533. sub Store    {$_[0]->{-ptr}->{$_[1]} = $_[2]}
  534.  
  535. # Hash access methods.
  536.  
  537. sub CLEAR    {$_[0]->callback(-clear)}
  538. sub DELETE   {$_[0]->callback('-delete', $_[1])}
  539. sub DESTROY  {$_[0]->callback(-destroy)}
  540. sub EXISTS   {$_[0]->callback('-exists', $_[1])}
  541. sub FETCH    {$_[0]->callback(-fetch, $_[1])}
  542. sub FIRSTKEY {$_[0]->callback(-firstkey)}
  543. sub NEXTKEY  {$_[0]->callback(-nextkey)}
  544. sub STORE    {$_[0]->callback(-store, $_[1], $_[2])}
  545.  
  546. 1;
  547.