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(@_);
}
# 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;
__END__
=head1 NAME
Class::FlyweightWrapper - wrap a class with a flyweight wrapper.
=head1 SYNOPSIS
package Private::Package;
use Class::FlyweightWrapper 'Public::Package' [, 'constructors', 'he
+re'];
# Implement Private::Package here
1;
# Then in user code
my $obj = Public::Package->new(@args);
# $obj has all of the same methods as something of Private::Package
# but is securely encapsulated.
=head1 DESCRIPTION
The flyweight pattern is a way of encapsulating an object in such a
way that it is impossible to get access to its private data. The
way you do it is have the public object be a reference to a scalar
which is a key into a hash that contains the data.
This module takes an existing class and creates another which looks
the same, but which is securely encapsulated. As long as the class
does not call caller, the proxying process should be completely
transparent. As a bonus, the proxied objects are all destroyed
before global destruction. If you are using a version of Perl before
5.8, this can give reliable destruction mechanics which otherwise
would be hard to come by.
When you use this module you need at to provide it with the name of
the package you want to wrap your current one, and an optional list
of all of the names of constructors people can use with your
package. If you do not provide that list then it will assume that
your constructor is called 'new'.
=head1 AUTHOR AND COPYRIGHT
Ben Tilly (ben_tilly@operamail.com).
Copyright 2001. This package is free software. It can be modified
and distributed on the same terms as Perl.
