view release on metacpan or  search on metacpan

lib/Data/Frame/Partial/Sugar.pm  view on Meta::CPAN

package Data::Frame::Partial::Sugar;
$Data::Frame::Partial::Sugar::VERSION = '0.006005';
# ABSTRACT: Partial class for data frame syntax sugar

use Data::Frame::Role;
use namespace::autoclean;

package Tie::Data::Frame {
$Tie::Data::Frame::VERSION = '0.006005';

    use Scalar::Util qw(weaken);
    use Types::PDL qw(Piddle);
    use Types::Standard qw(ArrayRef Value);
    use Type::Params;

    sub new {
        my ($class, $object) = @_;
        my $self = bless( { _object => $object }, $class);
        weaken( $self->{_object} );
        return $self;
    }

    sub TIEHASH {
        my $class = shift;
        return $class->new(@_);
    }

    sub object { $_[0]->{_object} }

    sub _check_key {
        my $self = shift;
        state $check = Type::Params::compile(Value | ArrayRef | Piddle);
        my ($key) = $check->(@_);
        return $key;
    }

    sub STORE {
        my ( $self, $key, $val ) = @_;
        $key = $self->_check_key($key);

        if ( Ref::Util::is_ref($key) ) {
            $self->object->slice($key) .= $val;
        } else {
            $self->object->set($key, $val);
        }
    }

    sub FETCH {
        my ( $self, $key ) = @_;
        $key = $self->_check_key($key);

        if ( Ref::Util::is_ref($key) ) {
            return $self->object->slice($key);
        } else {
            return $self->object->at($key);
        }
    }

    sub EXISTS {
        my ($self, $key) = @_;
        return $self->object->exists($key);
    }

    sub FIRSTKEY {
        my ($self) = @_;
        $self->{_list} = [ @{$self->object->names} ];
        return $self->NEXTKEY;
    }

    sub NEXTKEY {
        my ($self) = @_;
        return shift @{$self->{_list}};
    }
}

use overload (
    '%{}' => sub {    # for working with Tie::Data::Frame
        my ($self)   = @_;

        # This is brittle as we are depending on an private thing of Moo... 
        my ($caller) = caller();
        if ( $caller eq 'Method::Generate::Accessor::_Generated' ) {
            return $self;
        }
        my $tmp = $self->_tie_hash; # avoid // as breaks Devel::Cover
        $tmp = $self if !defined $tmp;
        $tmp;
    },
    fallback => 1
);

has _tie_hash => ( is => 'rw' );

method _initialize_sugar() {
    my %hash;
    tie %hash, qw(Tie::Data::Frame), $self;
    $self->_tie_hash( \%hash );
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::Frame::Partial::Sugar - Partial class for data frame syntax sugar

=head1 VERSION