File Coverage

blib/lib/Function/Fallback/CoreOrPP.pm

Criterion	Covered	Total	%
statement	26	45	57.7
branch	11	24	45.8
condition			n/a
subroutine	6	8	75.0
pod	4	4	100.0
total	47	81	58.0

package Function::Fallback::CoreOrPP;

use 5.010001;
use strict;
use warnings;

our $VERSION = '0.07'; # VERSION

our $USE_NONCORE_XS_FIRST = 1;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(
                       clone
                       clone_list
                       unbless
                       uniq
               );

sub clone {
    my $data = shift;
    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
    goto FALLBACK unless eval { require Data::Clone; 1 };

  STANDARD:
    return Data::Clone::clone($data);

  FALLBACK:
    require Clone::PP;
    return Clone::PP::clone($data);
}

sub clone_list {
    map { clone($_) } @_;
}

sub _unbless_fallback {
    my $ref = shift;

    my $r = ref($ref);
    # not a reference
    return $ref unless $r;

    # return if not a blessed ref
    my ($r2, $r3) = "$ref" =~ /(.+)=(.+?)\(/
        or return $ref;

    if ($r3 eq 'HASH') {
        return { %$ref };
    } elsif ($r3 eq 'ARRAY') {
        return [ @$ref ];
    } elsif ($r3 eq 'SCALAR') {
        return \( my $copy = ${$ref} );
    } else {
        die "Can't handle $ref";
    }
}

sub unbless {
    my $ref = shift;

    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
    goto FALLBACK unless eval { require Acme::Damn; 1 };

  STANDARD:
    return Acme::Damn::damn($ref);

  FALLBACK:
    return _unbless_fallback($ref);
}

sub uniq {
    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
    goto FALLBACK unless eval { require List::MoreUtils; 1 };

  STANDARD:
    return List::MoreUtils::uniq(@_);

  FALLBACK:
    my %h;
    my @res;
    for (@_) {
        push @res, $_ unless $h{$_}++;
    }
    return @res;
}

1;
# ABSTRACT: Functions that use non-core XS module but provide pure-Perl/core fallback

__END__