File Coverage

blib/lib/Data/Object/Singleton.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	2	4	50.0
condition	3	6	50.0
subroutine	7	7	100.0
pod			n/a
total	38	43	88.3

# A Singleton Class for Perl 5
package Data::Object::Singleton;

use 5.010;
use Data::Object::Class ();

our $VERSION = '0.20'; # VERSION

sub import {
    my $target = caller;
    my $class  = shift;
    my @export = @_;

    Data::Object::Class->import($target, @export);

    my $hold;

    if (my $orig = $class->can('new')) {
        no strict 'refs';
        *{"${target}::new"} = sub {
            $hold //= $orig->(@_)
        };
    }

    if (my $orig = $class->can('new') and !$class->can('renew')) {
        no strict 'refs';
        *{"${target}::renew"} = sub {
            $hold = $orig->(@_)
        };
    }

    return;
}

1;