File Coverage

blib/lib/Aion/Meta/Util.pm

Criterion	Covered	Total	%
statement	184	218	84.4
branch	94	140	67.1
condition	10	13	76.9
subroutine	56	65	86.1
pod	60	60	100.0
total	404	496	81.4

package Aion::Meta::Util;

use common::sense;

require overload;
use Scalar::Util qw//;
use Exporter qw/import/;

our @EXPORT = our @EXPORT_OK = grep {
	my $x = $Aion::Meta::Util::{$_};
	!ref $x
	&& *{$x}{CODE}
	&& !/^(_|(NaN|import)\z)/n
} keys %Aion::Meta::Util::;

# Создаёт геттеры
sub create_getters(@) {
	my $pkg = caller;
	eval "package $pkg; sub $_ {
		die \"$_ is ro\" if \@_ > 1;
		shift->{$_}
	} 1" or die for @_;
}

# Создаёт геттеры/сеттеры
sub create_accessors(@) {
	my $pkg = caller;
	eval "package $pkg; sub $_ {
		if(\@_ > 1) { \$_[0]->{$_} = \$_[1]; \$_[0] }
		else { shift->{$_} }
	} 1" or die for @_;
}

# Проверяет, имеет ли подпрограмма тело
sub subref_is_reachable {
    my ($subref) = @_;
    require B;
    my $cv = B::svref_2object($subref);
    return !(B::class($cv->ROOT) eq 'NULL' && !${ $cv->const_sv });
}

# Символьное представление значения
use constant {
	MAX_DEPTH => 2,
	MAX_HASH_SIZE => 6,
	MAX_ARRAY_SIZE => 6,
	MAX_SCALAR_LENGTH => 255,
};

sub val_to_str($;$);
sub val_to_str($;$) {
	my ($v, $depth) = @_;

	if (!defined $v) { 'undef' }
	elsif (ref $v eq 'ARRAY') {
		if($depth > MAX_DEPTH) { '[...]' }
		else {
			$depth++;
			join '', '[', join(', ', map({ val_to_str($_, $depth) } (
				@$v > MAX_ARRAY_SIZE ? @$v[0..MAX_ARRAY_SIZE] : @$v
			)), @$v > MAX_ARRAY_SIZE ? '...' : ()), ']';
		}
	}
	elsif (ref $v eq 'HASH') {
		if($depth > MAX_DEPTH) { '{...}' }
		else {
			$depth++;
			join '', '{', join(', ', map({
				qq{$_ => ${\val_to_str($v->{$_}, $depth)}} } (
					keys %$v > MAX_HASH_SIZE
					? (sort keys %$v)[0..MAX_HASH_SIZE]
					: sort keys %$v
				)), keys %$v > MAX_HASH_SIZE ? '...' : ()), '}';
		}
	}
	else {
		my $no_str = ref $v || Scalar::Util::looks_like_number($v);

		if(ref $v eq 'Regexp') {
			$v = "$v";
			$v =~ s{^\(\?\^?([a-z]*):(.*)\)$}{qr/$2/$1}si;
		}
		else {
			$v = overload::Overloaded($v) && !overload::Method($v, '""')
				? join("#", Scalar::Util::reftype($v), Scalar::Util::refaddr($v))
				: "$v";
		}
		$v = substr($v, 0, MAX_SCALAR_LENGTH) . '...'
			if length($v) > MAX_SCALAR_LENGTH;
		$no_str ? $v : "'${\ $v =~ s/['\\]/\\$&/gr }'"
	}
}

1;

__END__