File Coverage

blib/lib/Class/SingletonProxy.pm

Criterion	Covered	Total	%
statement	16	30	53.3
branch	0	2	0.0
condition	0	6	0.0
subroutine	6	11	54.5
pod	2	3	66.6
total	24	52	46.1

package Class::SingletonProxy;

our $VERSION = '0.01';

use 5.008;
use strict;
use warnings;
use Carp ();

our %target;

sub import {
    my $class = shift;
}

sub new { Carp::croak "new called on a singleton class" }

sub singleton {
    my $class = shift;
    @_ ? $target{$class} = shift : $target{$class}
}

sub SINGLETON {
    my $class = shift;
    Carp::croak("SINGLETON subroutine not defined in class $class");
}

our $AUTOLOAD;

sub AUTOLOAD {
    my $class = $_[0];
    my ($method) = $AUTOLOAD =~ /([^:]*)$/;
    # print "autoloading ${class} -> ${method} ($AUTOLOAD)\n";
    no strict 'refs';
    *{$AUTOLOAD} =
	sub {
	    my $class = shift;
	    # print "class=$class target=$target{$class}\n";
	    my $self = $target{$class} ||=
		( $class->SINGLETON or Carp::croak "$class->SINGLETON returned undef" );
	    $self->$method(@_)
	};
    goto &{$AUTOLOAD};
}



1;
__END__