File Coverage

blib/lib/Class/Anonymous.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	11	12	91.6
condition			n/a
subroutine	12	12	100.0
pod	4	4	100.0
total	69	70	98.5

package Class::Anonymous;

use strict;
use warnings;

our $VERSION = '0.03';
$VERSION = eval $VERSION;

use Class::Anonymous::Instance;

use Exporter 'import';
our @EXPORT = qw/class extend via/;

use List::Util 'first';
use Scalar::Util 'refaddr';

my $bless = eval {
  require Package::Anon;
  my $stash = Package::Anon->new;
  $stash->add_method(AUTOLOAD => \&Class::Anonymous::Instance::AUTOLOAD);
  $stash->add_method(DESTROY  => \&Class::Anonymous::Instance::DESTROY);
  $stash->add_method(can => \&Class::Anonymous::Instance::can);
  $stash->add_method(isa => \&Class::Anonymous::Instance::isa);
  sub { $stash->bless($_[0]) };
} || sub { bless $_[0], 'Class::Anonymous::Instance' };

our $CURRENT;

my $new = sub {
  my $class = shift;
  my @isa = $class->isa();
  push @isa, $class;
  my $self = instance(@isa);
  local $CURRENT = $self;
  $_->('BUILD')->($self, @_) for @isa;
  return $self;
};

sub instance {
  my @isa = @_;
  my %methods;

  my $isa = sub {
    my $self = shift;
    return @isa unless @_;
    my $class = shift;
    return unless ref $class;
    my $addr = refaddr $class;
    return first { $addr == refaddr $_ } reverse @isa;
  };

  return $bless->(sub {
    return unless my $name = shift;
    return $isa if $name eq 'isa';
    return $new if $name eq 'new';
    $methods{$name} = shift if @_;
    return $methods{$name};
  });
};

sub class (&) {
  my $builder = shift;
  my $class = instance(@_);
  $class->(BUILD => $builder);
  return $class;
}

sub extend {
  my ($class, $extension) = @_;
  my @isa = $class->isa();
  return &class($extension, @isa, $class);
}

sub via (&) { $_[0] }

1;

=head1 NAME

Class::Anonymous - Truly private classes with private data for Perl5

=head1 SYNOPSIS

  use feature 'say';
  use Class::Anonymous;
  use Class::Anonymous::Utils ':all';

  my $lifeform = class {
    my ($self, $name) = @_;
    method greeting => sub { "My name is $name" };
  };

  my $mortal = extend $lifeform => via {
    my ($self, $name, $age) = @_;
    around greeting => sub {
      my $orig = shift;
      $orig->() . " and I'm $age years old";
    };
  };

  my $bob = $mortal->new('Bob', 40);
  say $bob->greeting;
  say 'Bob is mortal' if $bob->isa($mortal);
  say 'Bob is a lifeform' if $bob->isa($lifeform);

=head1 DESCRIPTION

L implements anonymous classes and private data.
This private data is just the lexical variables available during the builder callback(s) that are used to build the class.
If L is available, then no stash entry is created at all.
If not, then the classes will actually be blessed into L though this is to be considered an implementation detail and subject to change.

The instance itself is a code reference which can be thought of as a meta-object.
Called with a single string fetches the method of that name and returns it.
Called with a string and a code reference attaches a new method to the object.
Helper functions are provided in L which provides L and method modifiers for ease of use.

  my $class = class {
    my ($self) = @_;
    $self->(mymethod = sub { ... });
    my $mymethod = $self->('mymethod');
  }

=head1 EXPORTED FUNCTIONS

=head2 class

  my $class = class { my ($self) = @_; ... };

Define a new class.
Takes a block (or code reference) which will be called to build and instance of that class.
The callback is called with the new empty instance and any arguments passed to C.
Note that subclasses might need more initialization arguments, so you might want to plan for that.

=head2 extend

  my $subclass = extend $class, sub { my ($self) = @_; ... };

Define a new subclass of an existing anonymous class.
Takes an existing class and a code reference which will be called after the parent class builder callback(s).
Note that all callbacks receive the same arguments, so you might want to plan for that.

=head2 via

  my $subclass = extend $class, via { my ($self) = @_; ... };

Sugar for defining a code reference as a block, simply to make L look better.

=head1 OTHER FUNCTIONS

=head2 instance

Builds a raw instance of a generic anonymous object.
All arguments are the classes to be returned by C.
By default it only fully implements the C, C and C methods.
If the instance implements the C method then it is itself a class and you can call C on it.

=head3 Relationship to the class function

The L function simply creates an C when it creates a class.
It then attaches a C function; this function creates another instance, calls all the C methods from all the C classes on it, then returns it.

=head1 SOURCE REPOSITORY

L

=head1 AUTHOR

Joel Berger, [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2015 by Joel Berger

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