view release on metacpan or  search on metacpan

lib/Devel/EnforceEncapsulation.pm  view on Meta::CPAN

our $VERSION = '0.51';

sub apply_to {
   my $pkg      = shift;
   my $dest_pkg = shift;
   my $opts     = shift || {};

   $opts->{policy} ||= 'croak';
   if (!eval { $pkg->can('_deref_overload_' . $opts->{policy}) }) {
      croak "Unknown encapsulation policy '$opts->{policy}'";
   }

   ## no critic(ProhibitStringyEval,RequireCarping)
   my $fn = __PACKAGE__ . '::_deref_overload_' . $opts->{policy};
   my $overloads = join q{,}, map { "'$_' => \\&$fn" } $pkg->_ops;
   eval "{package $dest_pkg; use overload $overloads, fallback => 1;}";
   die $EVAL_ERROR if $EVAL_ERROR;
   return;
}

sub remove_from {
   my $pkg      = shift;
   my $dest_pkg = shift;

   ## no critic(ProhibitStringyEval,RequireCarping)
   my $overloads = join q{,}, map { "'$_'" } $pkg->_ops;
   eval "{package $dest_pkg; no overload $overloads, 'fallback';}";
   die $EVAL_ERROR if $EVAL_ERROR;
   return;
}

## possible callbacks to be installed via overload ##

sub _deref_overload_croak {
   my $self = shift;

   my $caller_pkg = caller;
   if (!$self->isa($caller_pkg)) {
      my $pkg = ref $self;
      croak "Illegal attempt to access $pkg internals from $caller_pkg";
   }
   return $self;
}

sub _deref_overload_carp {
   my $self = shift;

   my $caller_pkg = caller;
   if (!$self->isa($caller_pkg)) {
      my $pkg = ref $self;
      carp "Illegal attempt to access $pkg internals from $caller_pkg";
   }
   return $self;
}

# get a list of overloadable derefs ('%{}', '@{}', '${}', ...)
sub _ops {
   my $pkg = shift;

   ## no critic(ProhibitPackageVars)
   return split m/\s/xms, $overload::ops{dereferencing};
}

1;

__END__

=pod

=for stopwords  perlmonks.org  ben Jore  Signes

=head1 NAME

Devel::EnforceEncapsulation - Find access violations to blessed objects

=head1 SYNOPSIS

  package BankAccount;
  sub new {
     my $pkg = shift;
     return bless {}, $pkg;
  }
  sub balance {
     my $self = shift;
     return $self->{balance};
  }
  # ... etc. ...
  
  package main;
  Devel::EnforceEncapsulation->apply_to('BankAccount');
  my $acct = BankAccount->new();
  print $acct->balance(),"\n";  # ok
  print $acct->{balance},"\n";  # dies

=head1 LICENSE

Copyright 2014 Chris Dolan, <cpan@chrisdolan.net>
Copyright 2006 Clotho Advanced Media, Inc., <cpan@clotho.com>

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 DESCRIPTION

Encapsulation is the practice of creating subroutines to access the
properties of a class instead of accessing those properties directly.
The advantage of good encapsulation is that the author is permitted to
change the internal implementation of a class without breaking its
usage.

Object-oriented programming in Perl is most commonly implemented via
blessed hashes.  This practice makes it easy for users of a class to
violate encapsulation by simply accessing the hash values directly.
Although less common, the same applies to classes implemented via
blessed arrays, scalars, filehandles, etc.

This module is a hack to block those direct accesses.  If you try to
access a hash value of an object from it's own class, or a superclass
or subclass, all goes well.  If you try to access a hash value from
any other package, an exception is thrown.  The same applies to the
scalar value of a blessed scalar, entry in a blessed array, etc.