use Shell qw(echo cat ps cp); #### package Class::FlyweightWrapper; $VERSION = 0.01; use strict; use Carp; my $BASE_PACKAGE = <<'EOT'; # line 1 "'Flyweight wrapper PUBLIC for PRIVATE'" package PUBLIC; my %object = qw(PUBLIC PRIVATE); sub DESTROY { delete $object{$_[0]}; } sub AUTOLOAD { my $meth = $PUBLIC::AUTOLOAD; $meth =~ s/.*:://; my $self = $object{shift(@_)}; return $self->$meth(@_); } sub can { my $self = $object{shift(@_)}; my ($method_name) = @_; return $self->can($method_name); } # Make sure things cleanup properly END { %object = (); } EOT my $BASIC_CONSTRUCTOR = <<'EOT'; sub CONSTRUCTOR { my $self = bless \ my $scalar, "PUBLIC"; my $class = shift; $object{$self} = $object{$class}->CONSTRUCTOR(@_); $self; } EOT sub import { shift; # Not interested in my package my $public = shift || croak("Usage: use Class::FlyweightWrapper 'Public::Package';"); my $private = caller(); my @constructors = @_ ? @_ : 'new'; my $template = $BASE_PACKAGE; $template =~ s/PUBLIC/$public/g; $template =~ s/PRIVATE/$private/g; foreach (@constructors) { my $piece = $BASIC_CONSTRUCTOR; $piece =~ s/CONSTRUCTOR/$_/g; $piece =~ s/PUBLIC/$public/g; $piece =~ s/PRIVATE/$private/g; $template .= $piece; } eval $template; if ($@) { confess("Template\n$template\ngave error $@"); } } 1; #### #!/usr/bin/perl package Test::Private; use Class::FlyweightWrapper "Test::Public"; sub new { return bless {}, ref($_[0]) || $_[0]; } sub helloWorld { print "Hello World!\n"; } package DerivedTest; @DerivedTest::ISA = qw(Test::Public); package main; my $test = Test::Public->new(); $test->helloWorld(); print (($test->can("helloWorld")) ? "we can\n" : "we can't\n"); my $test2 = DerivedTest->new(); # <<< dies here $test2->helloWorld(); print (($test2->can("helloWorld")) ? "we can\n" : "we can't\n"); 1; #### Hello World! we can Can't call method "new" on an undefined value at 'Flyweight wrapper Test::Public for Test::Private' line 24.