File Coverage

blib/lib/Function/Fallback/CoreOrPP.pm

Criterion	Covered	Total	%
statement	28	47	59.5
branch	13	26	50.0
condition			n/a
subroutine	7	9	77.7
pod	4	4	100.0
total	52	86	60.4

package Function::Fallback::CoreOrPP;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-02-03'; # DATE
our $DIST = 'Function-Fallback-CoreOrPP'; # DIST
our $VERSION = '0.090'; # VERSION

use 5.010001;
use strict;
use warnings;

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} );
    } elsif ($r3 eq 'CODE') {
        return sub { goto &$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__