home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / DragDrop / Common.pm next >
Encoding:
Perl POD Document  |  1997-08-10  |  1.2 KB  |  69 lines
  1. package Tk::DragDrop::Common;
  2.  
  3. use strict;
  4. use Carp;
  5.  
  6. sub Type
  7. {
  8.  my ($base,$name,$class) = @_;
  9.  no strict 'refs';
  10.  my $hash  = \%{"${base}::type"};
  11.  my $array = \@{"${base}::types"};
  12.  unless (exists $hash->{$name})
  13.   {
  14.    push(@$array,$name);
  15.    $class = (caller(0))[0] unless (@_ > 2); 
  16.    $hash->{$name} = $class;
  17.    # confess "Strange class $class for $base/$name" unless ($class =~ /^Tk/);
  18.    # print "$base $name is ",$class,"\n";
  19.   }
  20. }
  21.  
  22. sub import
  23. {
  24.  my $class = shift;
  25.  no strict 'refs';
  26.  my $types = \%{"${class}::type"};
  27.  while (@_)
  28.   {
  29.    my $type = shift;
  30.    unless (exists $types->{$type})
  31.     {
  32.      if ($type eq 'Local')
  33.       {
  34.        $class->Type($type,$class);
  35.       }
  36.      else
  37.       {
  38.        my ($kind) = $class =~ /([A-Z][a-z]+)$/;
  39.        # print "$type $class is kind of '$kind'\n";
  40.        my $file = Tk->findINC("DragDrop/${type}${kind}.pm");
  41.        if (defined $file)
  42.         {
  43.          # print "Loading $file\n"; 
  44.          require $file; 
  45.         }
  46.        else
  47.         {
  48.          croak "Cannot find ${type}${kind}";
  49.         }
  50.       }
  51.     }
  52.   }
  53. }
  54.  
  55. 1;
  56. __END__
  57.  
  58. =head1 NAME
  59.  
  60. Tk::DragDrop::Common - private class used by Drag&Drop
  61.  
  62. =head1 DESCRIPTION
  63.  
  64. This class provides methods to automate the the loading and declaring 
  65. of Drop and Site 'types'.
  66.  
  67.  
  68.  
  69.