Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

Class::FlyweightWrapper

by tilly (Archbishop)
on Aug 10, 2001 at 08:05 UTC ( [id://103755]=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info
Description: This is a proof of concept for how to automatically encapsulate one class with an implementation done in another one. It also implements what I mentioned could be done at Re (tilly) 3: Tie & Destroy, OOP. For more on this idea see the alternate implementation at Class::Flyweight - implement the flyweight pattern in OO perl.
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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://103755]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others taking refuge in the Monastery: (6)
As of 2024-10-03 10:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The PerlMonks site front end has:





    Results (42 votes). Check out past polls.

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.