File Coverage

blib/lib/Role/Singleton/New.pm

Criterion	Covered	Total	%
statement	29	29	100.0
branch	6	6	100.0
condition			n/a
subroutine	5	5	100.0
pod	1	1	100.0
total	41	41	100.0

package Role::Singleton::New;

## no critic (RequireUseStrict) - Role::Tiny does strict
use Role::Tiny;

$Role::Singleton::New::VERSION = '0.2';

sub turn_new_into_singleton {
    my ($self) = @_;
    my $class = ref($self);
    die "turn_new_into_singleton() must be called by an object" if !$class;

    no strict 'refs';    ## no critic

    die "turn_new_into_singleton() can not be called after turn_new_into_multiton()" if ${ $class . '::_multiton_orig_new' };

    if ( ${ $class . '::_singleton_orig_new' } ) {
        ${ $class . '::_singleton' } = $self;
    }
    else {
        ${ $class . '::_singleton_orig_new' } = \&{ $class . '::new' };
        ${ $class . '::_singleton' }          = $self;

        no warnings 'redefine';
        *{ $class . '::new' } = sub {
            return ${ $class . '::_singleton' };
          }
    }

    return ${ $class . '::_singleton' };
}

# around 'new' => sub {
#     my ( $orig, $self, @args ) = @_;
#     my $class = ref($self) || $self;
#
#     no strict 'refs';    ## no critic
#     return ${ $class . '::_singleton' } ||= $orig->( $self, @args );
# };

1;

__END__