view release on metacpan or  search on metacpan

lib/Acme/SafetyGoggles.pm  view on Meta::CPAN

package Acme::SafetyGoggles;

use warnings;
use strict;
use Carp;
use Filter::Simple;
use Text::Diff ();

$Carp::Internal{'Filter::Simple'}++;
our $VERSION = '0.06';

no warnings 'unopened';
no warnings 'redefine';
*DIAG = $ENV{ACME_SAFETYGOGGLES_DIAG} ? *STDERR : *DEVNULL;

my ($state, $diff);
sub state { $state }
sub diff  { $diff  }

sub _set_current {
  print DIAG "A::SG::_set_current => \n\n\n==========\n$_\n==========\n\n\n\n";
  our $current;
  $current = $_ if length($_);
}



CHECK {
  print DIAG "A::SG::CHECK\n";
  &apply_safety_goggles;
}

BEGIN {
  our @caller = caller(2);
  # caller(0) and caller(1) both refer to this BEGIN block
  print DIAG "A::SG::BEGIN => @caller[0..2]\n";
}

FILTER {
  print DIAG "A::SG::FILTER\n";
  _set_current;
};

{
  package Filter::Simple;

  # hijack  Filter::Simple::filter_add  to make filtered code
  # available to this module.

  *Filter::Simple::filter_add_ORIG = \&Filter::Simple::filter_add;

  *Filter::Simple::filter_add = sub ($) {
    my $code = shift;
    Filter::Simple::filter_add_ORIG(
	sub {
	  print Acme::SafetyGoggles::DIAG "IN F::S::fa\n";
	  my $count = $code->();
	  Acme::SafetyGoggles::_set_current;
	  return $count;
	} );
  }
}

sub apply_safety_goggles {

  our @caller;
  our $current;

print DIAG "applying safety googles\n";

  FILTER { _set_current };

  my ($pkg, $file, $l) = @caller;

  if ($file eq '-e') {
    carp "Acme::SafetyGoggles cannot protect against code in an '-e' construction";
    return;
  }

  my $vh;
  unless (open $vh, '<', $file) {
    carp "Acme::SafetyGoggles: cannot read source file $file ! $!\n";
    return;