File Coverage

blib/lib/MooseX/AccessorsOnly.pm

Criterion	Covered	Total	%
statement	15	31	48.3
branch	0	8	0.0
condition	0	7	0.0
subroutine	5	9	55.5
pod			n/a
total	20	55	36.3

package MooseX::AccessorsOnly;

our $VERSION = '1';
$VERSION = eval $VERSION;

use warnings;
use strict;
use Carp ();
use Tie::Hash;
our @ISA = 'Tie::StdHash';

our %magic; # Global on the off chance somebody wants to fuck with it

sub TIEHASH {
  my $self = shift;
  my $store = $self->SUPER::TIEHASH();
  if (ref $_[0]) {
    $magic{"$store"}{cb} = $_[0];
  } else {
    my $complainer = $_[0] || 'carp';
    Carp::croak "Invalid complainer $complainer"
      unless grep { $complainer eq $_ }
        qw(carp croak confess cluck die warn);
    $complainer = 'Carp::' . $complainer if $complainer =~ /^c/; # convenient
    # Eugh:
    $magic{"$store"}{cb} = eval qq{
      sub {
        my (\$who, \$how, \$what) = \@_;
        $complainer ("DIRECT ACCESS from \$who: \$how " . \$what || 'NOKEY');
      }
    };
  }
  $store;
}

sub DESTROY {
  delete $magic{"$_[0]"};
  # Tie::StdHash doesn't have a DESTROY method
}

sub UNTIE { Carp::croak "Attempt to UNTIE" }

for my $sub (qw(
                 CLEAR
                 DELETE
                 EXISTS
                 FETCH
                 FIRSTKEY
                 NEXTKEY
                 SCALAR
                 STORE
              )) {
  my $super = 'SUPER::' . $sub;
  no strict 'refs';
  *$sub = sub {
    my $self = shift;
    my @caller = caller(0);
    $magic{"$self"}{cb}->("$caller[0]:$caller[2]", $sub, $_[0])
      unless (caller(2))[0] || '' eq 'Moose::Object'
      or $caller[0] =~ /^(?:Eval::Closure|Data::Dump)/;
    $self->$super(@_);
  };
}

1;

__END__