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', 'here'];
  # 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.