home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _2bbdf77c89f1b065b2ac63a9679ead23 < prev    next >
Encoding:
Text File  |  2004-06-01  |  795 b   |  47 lines
  1. package Tk::Submethods;
  2.  
  3. use vars qw($VERSION);
  4. $VERSION = '4.004'; # $Id: //depot/Tkutf8/Tk/Submethods.pm#4 $
  5.  
  6. sub import
  7. {
  8.  my $class = shift;
  9.  no strict 'refs';
  10.  my $package = caller(0);
  11.  while (@_)
  12.   {
  13.    my $fn = shift;
  14.    my $sm = shift;
  15.    foreach my $sub (@{$sm})
  16.     {
  17.      my ($suffix) = $sub =~ /(\w+)$/;
  18.      my $pfn = $package.'::'.$fn;
  19.      *{$pfn."\u$suffix"} = sub { shift->$pfn($sub,@_) };
  20.     }
  21.   }
  22. }
  23.  
  24. sub Direct
  25. {
  26.  my $class = shift;
  27.  no strict 'refs';
  28.  my $package = caller(0);
  29.  while (@_)
  30.   {
  31.    my $fn = shift;
  32.    my $sm = shift;
  33.    my $sub;
  34.    foreach $sub (@{$sm})
  35.     {
  36.      # eval "sub ${package}::${sub} { shift->$fn('$sub',\@_) }";
  37.      *{$package.'::'.$sub} = sub { shift->$fn($sub,@_) };
  38.     }
  39.   }
  40. }
  41.  
  42. 1;
  43.  
  44. __END__
  45.  
  46. =cut
  47.