in reply to DWIM: autoloading classes

Does this weird piece of code do what you want? (Needless note to others: Don't use this code. Note to self: Don't write such code!)
package StupidAutoloader; use strict; use warnings; use Carp; our %Classes; sub import { my $class = shift; my @hierarchies = @_; %Classes = map {($_, undef)} @hierarchies; *UNIVERSAL::new = sub { my $proto = $_[0]; my $class = ref($proto) || $proto; croak "Could not find method new() in package '$class'." if ref($proto) or exists $INC{$class} or not in_hierarchy(\%Classes, $class); eval "use $class;"; croak "Error loading module '$class': $@" if $@; no strict 'refs'; goto &{"${class}::new"}; }; } sub in_hierarchy { my $h = shift; my $c = shift; return 1 if exists $h->{$c}; my @levels = split /::/, $c; my $accum; foreach (@levels) { $accum .= $_; return 1 if exists $h->{"${accum}::*"} } return 0; } 1;
---
#!/usr/bin/perl use strict; use warnings; use StupidAutoloader 'Data::*'; my $d = Data::Dumper->new([]); print "$d\n"; my $g = Data::Grouper->new(a => []); print "$g\n";

Replies are listed 'Best First'.
Re: Re: DWIM: autoloading classes
by Ovid (Cardinal) on Sep 17, 2003 at 14:17 UTC

    That's a very interesting piece of code. It never ceases to amaze what sort of things we can do with Perl. The only problem is that not all constructors are named 'new' :)

    Cheers,
    Ovid

    New address of my CGI Course.

      That problem is alleviated by fiendishly abusing AUTOLOAD in UNIVERSAL. (There are people who'd kill for this... if you use it in production!) ---
      #!/usr/bin/perl use strict; use warnings; use StupidAutoloader qw/Math::* Data::*/; my $function = Math::Symbolic->parse_from_string('1/2*m*v^2'); print $function->simplify(), "\n"; # Doesn't work because Math::Symbolic::Operator *implicitly requires o +ther # modules in the Math::Symbolic:: hierarchy: # my $op = Math::Symbolic::Operator->new(...); my $cmplx = Math::Complex->new(3, 2); print $cmplx; print Data::Dumper->Dump([$function]); # Even this works: use StupidAutoloader '*'; my $cgi = CGI->new(); print $cgi->header();
      module:
      package StupidAutoloader; use strict; use warnings; use Carp; our %Classes; our $AUTOLOAD; *UNIVERSAL::AUTOLOAD = sub { my $proto = $_[0]; my $class = ref($proto) || $proto; my $method_name = $AUTOLOAD; die "Could not determine method name." if not defined $method_name; $method_name =~ /::(\w+)$/ or die; $method_name = $1; croak "Could not find method new() in package '$class'." if ref($proto) or exists $INC{$class} or (not _in_hierarchy(\%Classes, $class) and not exists $Classes +{'*'}); eval "use $class;"; croak "Error loading module '$class': $@" if $@; no strict 'refs'; goto &{"${class}::${method_name}"}; }; sub import { my $class = shift; my @hierarchies = @_; foreach (@hierarchies) { $Classes{$_} = undef; } } sub unimport { my $class = shift; my @hierarchies = @_; if (not @hierarchies) { %Classes = (); } foreach (@hierarchies) { delete $Classes{$_}; } } sub _in_hierarchy { my $h = shift; my $c = shift; return 1 if exists $h->{$c}; my @levels = split /::/, $c; my $accum; foreach (@levels) { $accum .= $_; return 1 if exists $h->{"${accum}::*"} } return 0; } 1;