File Coverage

blib/lib/Text/MicroMason/Safe.pm

Criterion	Covered	Total	%
statement	27	42	64.2
branch	3	14	21.4
condition	1	3	33.3
subroutine	8	12	66.6
pod	3	3	100.0
total	42	74	56.7

package Text::MicroMason::Safe;

use strict;
use Carp;

use Safe;

######################################################################

sub eval_sub {
  my ( $self, $code ) = @_;

  my $safe = $self->safe_compartment();

  local $Text::MicroMason::Commands::m = $self->safe_facade();
  $safe->share_from( 'Text::MicroMason::Commands' => [ '$m' ] );

  $safe->reval( "my \$m = \$m; $code", 1 )
}

# $self_or_safe = $mason->safe_compartment();
sub safe_compartment {
  my $self = shift;

  if ( ! $self->{safe} or $self->{safe} eq '1' ) {
    return Safe->new()
  } elsif ( UNIVERSAL::can( $self->{safe}, 'reval' ) ) {
    return $self->{safe}
  } else {
    $self->croak_msg("Inappropriate Safe compartment:", $self->{safe});
  }
}

sub safe_facade {
  my $self = shift;

  our @CARP_NOT = qw(Text::MicroMason::Base);

  carp("* WARNING: safe_methods is deprecated; please see the pod")
      if $self->{safe_methods};

  Text::MicroMason::Safe::Facade->new(
    map {
      my $method = $_;
      $_ => sub { $self->$method( @_ ) }
    }
    map { ! $_ ? () : ref($_) ? @$_ : split ' ' } $self->{safe_methods}
  )
}

######################################################################

package Text::MicroMason::Safe::Facade;

sub new {
  my $class = shift;
  bless { @_ }, $class
}

sub facade_method {
  my ( $self, $method, @args ) = @_;
  my $sub = $self->{$method}
      or die "Can't call \$m->$method() in this compartment";
  &$sub( @args )
}

sub AUTOLOAD {
  my $sym = $Text::MicroMason::Safe::Facade::AUTOLOAD;
  my ($package, $func) = ($sym =~ /(.*)::([^:]+)$/);
  return unless ( $func =~ /^[a-z\_]+$/ );
  no strict;
  my $sub = *{$func} = sub { (shift)->facade_method($func, @_ ) };
  goto &$sub;
}

######################################################################

1;

__END__