Class::SingletonProxy - proxy class methods to a singleton

Class-SingletonProxy documentation Contained in the Class-SingletonProxy distribution.

Index

Code Index:

NAME

Top

Class::SingletonProxy - proxy class methods to a singleton

SYNOPSIS

Top

  package Foo;
  use base Class::SingletonProxy;

  sub SINGLETON {
      return Foo::Impl->new();
  }

  package main;

  Foo->hello;
  Foo->bar(1234);

DESCRIPTION

Top

classes derived from Class::SingletonProxy redirect class methods to (per class) singleton objects.

METHODS

$class->SINGLETON()

this method can be redefined on subclasses and is automatically called to create the singleton when it has not been previously defined.

$class->singleton()
$class->singleton($singleton)

gets/sets the class singleton object.

COPYRIGHT AND LICENSE

Top

Copyright (C) 2005 by Salvador Fandiño <sfandino@yahoo.com>.

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

Class-SingletonProxy documentation Contained in the Class-SingletonProxy distribution. 
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__