view release on metacpan or  search on metacpan

lib/PDLx/Mask.pm  view on Meta::CPAN

# ABSTRACT: Mask multiple piddles with automatic two way feedback
package PDLx::Mask;

use strict;
use warnings;
use Carp;

use v5.10;

our $VERSION = '0.06';

use Params::Check qw[ check ];
use Ref::Util ':all';
use Data::GUID;
use Safe::Isa;

use PDL::Core ':Internal';


use Moo;
use MooX::ProtectedAttributes;

use namespace::clean;

extends 'PDLx::DetachedObject';

with 'PDLx::Role::RestrictedPDL';


use overload
  map {
    my $mth = overload::Method( 'PDL', $_ );
    $_ => sub {
        # operator should work on base value, not
        # effective mask
        my $mask = $_[0]->{PDL};
        $_[0]->{PDL} = $_[0]->base;
        my $r = &$mth;
        $_[0]->{PDL} = $mask;
        $_[0]->clear_nvalid;
        $_[0]->update;
        $_[0];
    }
  } qw[ |= &= ^= .= ];

has base => (
    is       => 'ro',
    required => 1,
    coerce   => sub {
        return topdl( $_[0] )->byte;
    },
);

has nvalid => (

    is        => 'lazy',
    init_args => undef,
    clearer   => 'clear_nvalid',
);

# PDL requires subclasses to have a PDL attribute, but it shouldn't be
# generally accessible outside of this class
protected_has PDL => ( is => 'rwp' );

protected_has subscribers => (
    is      => 'ro',
    default => sub { {} },
);

sub BUILDARGS {

    my $class = shift;