home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / Submethods.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  1.2 KB  |  65 lines
  1. package Tk::Submethods;
  2.  
  3. sub import
  4. {
  5.  my $class = shift;
  6.  no strict 'refs';
  7.  my $package = caller(0);
  8.  while (@_)
  9.   {
  10.    my $fn = shift;
  11.    my $sm = shift;
  12.    my $sub;
  13.    foreach $sub (@{$sm})
  14.     {
  15.      my ($suffix) = $sub =~ /(\w+)$/;
  16.      *{$package.'::'."$fn\u$suffix"} = sub { shift->$fn($sub,@_) };
  17.     }
  18.   }
  19. }
  20.  
  21. sub Direct
  22. {
  23.  my $class = shift;
  24.  no strict 'refs';
  25.  my $package = caller(0);
  26.  while (@_)
  27.   {
  28.    my $fn = shift;
  29.    my $sm = shift;
  30.    my $sub;
  31.    foreach $sub (@{$sm})
  32.     {
  33.      # eval "sub ${package}::${sub} { shift->$fn('$sub',\@_) }";
  34.      *{$package.'::'.$sub} = sub { shift->$fn($sub,@_) };
  35.     }
  36.   }
  37. }
  38.  
  39. 1;
  40.  
  41. __END__
  42.  
  43. =head1 NAME
  44.  
  45. Tk::Submethods - add aliases for tk sub-commands
  46.  
  47. =head1 SYNOPSIS
  48.  
  49.   use Tk::Submethods ( 'command1' => [qw(sub1 sub2 sub3)],
  50.                        'command2' => [qw(sub1 sub2 sub3)]);  
  51.  
  52.  
  53. =head1 DESCRIPTION
  54.  
  55. Creates C<-E<gt>commandSub(...)> as an alias for C<-E<gt>command('sub',...)>
  56. e.g. C<-E<gt>grabRelease> for C<-E<gt>grab('release')>.
  57.  
  58. For each command/subcommand pair this creates a closure with command
  59. and subcommand as bound lexical variables and assigns a reference to this
  60. to a 'glob' in the callers package.
  61.  
  62. Someday the sub-commands may be created directly in the C code.
  63.  
  64. =cut
  65.