File Coverage

blib/lib/Struct/WOP.pm

Criterion	Covered	Total	%
statement	55	57	96.4
branch	28	34	82.3
condition	17	33	51.5
subroutine	12	13	92.3
pod	2	2	100.0
total	114	139	82.0

package Struct::WOP;

use 5.006;
use strict;
use warnings;

use Scalar::Util qw/reftype refaddr/;
use Encode qw/decode encode/;

our $VERSION = '0.20';
our (%HELP, @MAYBE, $caller, $destruct);
BEGIN {
	%HELP = (
		arrayref => sub { return map { $_[0]->($_, $_[2]) } @{ $_[1] } },
		hashref => sub { $caller->can('filter_keys') && $caller->filter_keys($_[1]->{$_}, $_) and next or
			$destruct && do { $_[3]{$_[0]->($_)} = $_[0]->($_[1]->{$_}, $_[2]) } || do { $_[1]->{$_} = $_[0]->($_[1]->{$_}, $_[2]) } for keys %{ $_[1] }; $_[3]; },
		scalarref => sub { ${$_[1]} =~ m/^(\d+(?:\.\d+)?)$/ ? $_[1] : do { ${$_[1]} =~ s/^(.*)$/$_[0]->(${$_[1]})/e; $_[1]; } && $destruct ? ${$_[1]} : $_[1]; },
		scalar => sub { return undef unless defined $_[1]; eval { $_[1] = $_[0]->($_, $_[1], Encode::FB_CROAK); 1; } and last foreach @MAYBE; $_[1] =~ m/^((?!0\d)^\d+(?:\.\d+)?)$/ ? ($_[1] + 0) : $_[1]; }
	);
}

sub import {
	my ($pkg) = shift;
	return unless my @export = @_;
	my $opts = ref $export[scalar @export - 1] ? pop @export : ['UTF-8'];
	@MAYBE = ref $opts eq 'HASH' ? do { $destruct = $opts->{destruct}; @{ $opts->{type} } } : @{ $opts };
	@export = qw/maybe_decode maybe_encode/ if scalar @export == 1 && $export[0] eq 'all';
	$caller = scalar caller();
	{
		no strict 'refs';
		do { *{"${caller}::${_}"} = \&{"${pkg}::${_}"} } foreach @export;
	}
}

sub maybe_decode {
	_maybe(shift, \&decode, \&maybe_decode, shift);
}

sub maybe_encode {
	_maybe(shift, \&encode, \&maybe_encode, shift);
}

sub _maybe {
	my $ref = reftype($_[0]);
	return $HELP{scalar}->($_[1], $_[0]) if !$ref;
	return $destruct ? _d_recurse($_[0], $ref, $_[2]) : _recurse($_[0], $ref, $_[2], $_[3] || {});
}

sub _recurse {
	my $addr = refaddr $_[0];
	return defined $_[3]->{$addr} ? $_[0] : do { $_[3]->{$addr} = 1 } && $_[1] eq 'SCALAR' ? $HELP{scalarref}->($_[2], $_[0]) : $_[1] eq 'ARRAY'
		? $HELP{arrayref}->($_[2], $_[0], $_[3]) && $_[0] : $_[1] eq 'HASH' ? $HELP{hashref}->($_[2], $_[0], $_[3], 1) && $_[0] : $_[0];
}

sub _d_recurse {
	return $_[1] eq 'SCALAR' ?  $HELP{scalarref}->($_[2], $_[0]) : $_[1] eq 'ARRAY' ? [ $HELP{arrayref}->($_[2], $_[0]) ] : $_[1] eq 'HASH' ? $HELP{hashref}->($_[2], $_[0], {}) : $_[0];
}

1;

__END__