view release on metacpan or  search on metacpan

Lexical.pm  view on Meta::CPAN

package Object::Lexical;

use 5.008;
use strict;
use warnings;

our $VERSION = '0.02';

use PadWalker;

my $counter = 0;

my $opt_wrap = 1;
my $opt_export = 1;
my $opt_nonlex = 1;

my %methods = ();

sub instance {

  # create a new object instance with its own stash from an existing object

  my $type = shift() || DB::_ext_fetch_args() || caller();

  my $package = sprintf 'Object::Lexical::X%09d', $counter++;

  # move methods into the new package from the symbol table. this is a destructive copy -
  # methods will need to be created again. this way, each copy has its own
  # seperate lexical data.

  no strict 'refs';

  if($opt_nonlex) {
    foreach my $x (keys %{$type.'::'}) {
      # no warnings 'redefine';
      next if $x eq 'new' or $x eq 'DESTROY' or $x eq 'instance' or $x eq 'method';
      next unless defined &{$type.'::'.$x};
      my $source = $type.'::'.$x;
      my $target = $package.'::'.$x;
      my $code = \&{$source};
      my $thisglob = $package.'::this';
      if($opt_wrap) {
        *{$target} = sub { *{$thisglob} = shift; goto &$code; };
      } else {
        *{$target} = $code;
      }
      undef *{$source};
    }
  }

  # move lexically defined subs, too

  my $pad = PadWalker::peek_my(1);
  foreach my $x (keys %$pad) {
    my $code = ${$pad->{$x}};
    next unless ref($code) eq 'CODE';
    substr($x, 0, 1, ''); # remove sigil
    my $target = $package.'::'.$x;
    my $thisglob = $package.'::this';
    if($opt_wrap) {
      *{$target} = sub { *{$thisglob} = shift; goto &$code; };
    } else {
      *{$target} = $code;
    }
  }

  # and anything defined with method()

  foreach my $x (keys %methods) {
    my $code = $methods{$x};
    my $target = $package.'::'.$x;
    my $thisglob = $package.'::this';
    if($opt_wrap) {
      *{$target} = sub { *{$thisglob} = shift; goto &$code; };
    } else {
      *{$target} = $code;
    }
  }

  # inherit whomever our client is inheriting.
  # count references for destruction - barrowed from Class::Object

  push @{$package.'::ISA'}, $type;
  ${$package.'::_count'} = 1;

  *{$package.'::DESTROY'} = sub {
     my $obj_class = ref shift; 
     ${$obj_class.'::_count'}--;
     if( ${$obj_class.'::_count'} == 0 ) {
        undef %{$obj_class.'::'};
     }
  };
  
  # bless \(my $foo), $package;
  bless \%{$package.'::'}, $package;

}

sub method (&*) {
  my $caller = caller;
  my $code = shift;
  my $name = shift;
  $methods{$name} = $code;
  # *{$caller.'::'.$name} = $code;
}

sub import {

  # cleaning up
  %methods = ();

  # default options
  $opt_wrap = 1;   # sub wrapper to read $this automatically

Lexical.pm  view on Meta::CPAN

but not of the form used by the builtin C<sub name { }>. This gives C<method { }>
a strange syntax.

Magic may not play nice with out modules that mangle the nametable or other
trickery. Best to confine use to small container objects and the like for now.
Unless you're brave.

=head2 EXPORT

C<instance()> is always exported, and so is C<method()> - unless the 
'noexport' option is given.

=head1 SEE ALSO

=over 1

=item http://perldesignpatterns.com/?AnonymousSubroutineObjects

=item L<Class::Classless>

Can easily provide the same facility as this module if closures
are passed to the C<sub()> method. Requires more syntax - 
Object::Lexical is specialized.

=item L<Class::Object>

Ditto. Barrowed code from. 

=item ImplicitThis

ImplicitThis, an earlier attempt, wrapped methods to automatically read C<$this>,
but it was error prone, and ignored the problem of accessing instance data.

=item L<Sub::Lexical>

Provides a syntax for lexically scoped subroutines. 

=back

=head1 AUTHOR

Scott Walters, E<lt>scott@slowass.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2003 by Scott Walters

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut

# 
# what if... methods were declared using some method 'foo' = sub { ... }; syntax
# (method() being lvalue) at the top level, and a lexical references module or
# B::Generate were used to minipulate, runtime, which lexicals each saw, so 
# code references could be copy, configured, and populated into namespaces?
#

#
# Lexical::Alias and PadWalker and AUTOLOAD together could do this:
# use the old-style hash dispatch logic, but before dispatching, each lexical
# in the PAD of the code reference would be aliased to a lexical stored in
# the per object hash.
#
# ie, given a blessed hash, $foo = { }, $foo->{my_method} might reference $a and $b.
# these would be aliased to $foo->{a} and $foo->{b} for that invocation
#

#
# changes
#

# 0.1: initial version
# 0.2: updated documentation to encourage use of Sub::Lexical, knocks docs around a bit.
#      no code changes.