home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 December / PCpro_2006_12.ISO / ossdvd / server / Perl2 / site / lib / Tk / DragDrop / Common.pm next >
Encoding:
Perl POD Document  |  2000-03-30  |  1.2 KB  |  60 lines
  1. package Tk::DragDrop::Common;
  2.  
  3. use strict;
  4. use Carp;
  5.  
  6. use vars qw($VERSION);
  7. $VERSION = '3.014'; # $Id: //depot/Tk8/DragDrop/DragDrop/Common.pm#14 $
  8.  
  9. sub Type
  10. {
  11.  my ($base,$name,$class) = @_;
  12.  no strict 'refs';
  13.  my $hash  = \%{"${base}::type"};
  14.  my $array = \@{"${base}::types"};
  15.  unless (exists $hash->{$name})
  16.   {
  17.    push(@$array,$name);
  18.    $class = (caller(0))[0] unless (@_ > 2);
  19.    $hash->{$name} = $class;
  20.    # confess "Strange class $class for $base/$name" unless ($class =~ /^Tk/);
  21.    # print "$base $name is ",$class,"\n";
  22.   }
  23. }
  24.  
  25. sub import
  26. {
  27.  my $class = shift;
  28.  no strict 'refs';
  29.  my $types = \%{"${class}::type"};
  30.  while (@_)
  31.   {
  32.    my $type = shift;
  33.    unless (exists $types->{$type})
  34.     {
  35.      if ($type eq 'Local')
  36.       {
  37.        $class->Type($type,$class);
  38.       }
  39.      else
  40.       {
  41.        my ($kind) = $class =~ /([A-Z][a-z]+)$/;
  42.        my $file = Tk->findINC("DragDrop/${type}${kind}.pm");
  43.        if (defined $file)
  44.         {
  45.          # print "Loading $file\n";
  46.          require $file;
  47.         }
  48.        else
  49.         {
  50.          croak "Cannot find ${type}${kind}";
  51.         }
  52.       }
  53.     }
  54.   }
  55. }
  56.  
  57. 1;
  58. __END__
  59.  
  60.