File Coverage

blib/lib/Data/OptList/Object.pm

Criterion	Covered	Total	%
statement	113	116	97.4
branch	34	36	94.4
condition	7	9	77.7
subroutine	39	41	95.1
pod	13	13	100.0
total	206	215	95.8

use 5.010;
use strict;
use warnings;

package Data::OptList::Object;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.001003';

use Exporter::Tiny qw( mkopt );
use List::Util 1.39 qw( first any uniqstr );
use Scalar::Util qw( blessed );
use re qw( is_regexp );
use namespace::autoclean;

use constant SLOT_OPTLIST => 0;
use constant SLOT_HASHREF => 1;
use constant NEXT_SLOT => 2;

use overload (
	q{bool}   => sub { !!1 },
	q{""}     => sub { sprintf( 'OptList(%s)', join q{ }, $_[0]->KEYS ) },
	q{0+}     => 'COUNT',
	q{%{}}    => 'TO_HASHREF',
	q{@{}}    => 'TO_ARRAYREF',
	q{qr}     => 'TO_REGEXP',
	fallback  => 1,
);

{
	package Data::OptList::Object::_Pair;
	our $AUTHORITY = 'cpan:TOBYINK';
	our $VERSION   = '0.001003';
	use overload (
		q{bool}   => 'exists',
		q{""}     => 'key',
		fallback  => 1,
	);
	sub key     { shift->[0] }
	sub value   { shift->[1] }
	sub exists  { !!1 }
	sub kind    { ref(shift->[1]) or 'undef' }
	sub TO_JSON { [ @{+shift} ] }
}

{
	package Data::OptList::Object::_NoValue;
	our $AUTHORITY = 'cpan:TOBYINK';
	our $VERSION   = '0.001003';
	our @ISA = 'Data::OptList::Object::_Pair';
	sub key     { defined $_[0][0] ? $_[0][0] : '' }
	sub value   { undef; }
	sub exists  { !!0 }
	sub kind    { '' }
	sub TO_JSON { undef; }
}

sub new {
	my $class = shift;
	$class = ref $class if ref $class;

	my $optlist =
		( @_ == 1 and 'ARRAY' eq ref $_[0] ) ? mkopt( $_[0] ) :
		( @_ == 1 and 'HASH'  eq ref $_[0] ) ? mkopt( $_[0] ) :
		( @_ == 1 and blessed $_[0] and $_[0]->DOES(__PACKAGE__) and $_[0]->can('TO_LIST') ) ? mkopt( [ $_[0]->TO_LIST ] ) :
		mkopt( \@_ );
	bless $_, __PACKAGE__ . '::_Pair' for @$optlist;

	my $self = bless \[ 0 .. $class->NEXT_SLOT - 1 ], $class;
	$$self->[SLOT_OPTLIST] = $optlist;
	$$self->[SLOT_HASHREF] = undef;

	&Internals::SvREADONLY( $_, 1 ) for @{ $$self->[SLOT_OPTLIST] };
	&Internals::SvREADONLY( $_, 1 ) for $$self->[SLOT_OPTLIST];
	&Internals::SvREADONLY( $_, 1 ) for $$self;

	return $self;
}

sub ALL {
	my $self = shift;

	return @{ $$self->[SLOT_OPTLIST] };
}

sub COUNT {
	my $self = shift;

	return scalar @{ $$self->[SLOT_OPTLIST] };
}

sub KEYS {
	my $self = shift;

	return map $_->[0], $self->ALL;
}

sub VALUES {
	my $self = shift;

	return map $_->[1], $self->ALL;
}

sub TO_LIST {
	my $self = shift;

	return map {
		my ( $key, $value ) = @$_;
		defined($value) ? ( $key => $value ) : ( $key );
	} $self->ALL;
}

sub TO_ARRAYREF {
	my $self = shift;

	return $$self->[SLOT_OPTLIST];
}

sub TO_JSON {
	my $self = shift;

	return [ $self->TO_LIST ];
}

sub TO_HASHREF {
	my $self = shift;

	if ( not defined $$self->[SLOT_HASHREF] ) {
		$$self->[SLOT_HASHREF] = +{ map {
			my ( $key, $value ) = @$_;
			( $key => $value );
		} $self->ALL };
		&Internals::SvREADONLY( $_, 1 ) for $$self->[SLOT_HASHREF];
	}

	return $$self->[SLOT_HASHREF];
}

sub TO_REGEXP {
	my $self = shift;

	my $re = join q{|}, map { quotemeta($_) } uniqstr( $self->KEYS );

	return qr/\A(?:$re)\z/;
}

sub GET {
	my $self    = shift;
	my $key     = shift;
	my $is_re   = is_regexp $key;
	my $is_code = ref($key) eq 'CODE';

	if ( wantarray ) {
		return grep {
			$is_re ? !!( $_->key =~ $key ) : $is_code ? $key->(@$_) : ( $_->key eq $key )
		} $self->ALL;
	}
	elsif ( defined wantarray ) {
		my $found = first {
			$is_re ? !!( $_->key =~ $key ) : $is_code ? $key->(@$_) : ( $_->key eq $key )
		} $self->ALL;
		return $found if $found;
		return bless [ $is_code ? undef : $key ], __PACKAGE__ . '::_NoValue';
	}
	else {
		return;
	}
}

sub HAS {
	my $self    = shift;
	my $key     = shift;
	my $is_re   = is_regexp $key;
	my $is_code = ref($key) eq 'CODE';

	return any {
		$is_re ? !!( $_->key =~ $key ) : $is_code ? $key->(@$_) : ( $_->key eq $key )
	} $self->ALL;
}

sub MATCH {
	my $self = shift;

	return $self->HAS( @_ );
}

sub AUTOLOAD {
	my $self = shift;

	our $AUTOLOAD;
	( my $key = $AUTOLOAD ) =~ s/.*:://;

	return $self->GET( $key );
}

1;

__END__