Acme-AtIncPolice

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN

# NAME

Acme::AtIncPolice - The police that opponents to @INC contamination

# SYNOPSIS

    use Acme::AtIncPolice;
    # be killed by Acme::AtIncPolice
    push @INC, sub {
        my ($coderef, $filename) = @_;
        my $modfile = "lib/$filename";
        if (-f $modfile) {
            open my $fh, '<', $modfile;
            return $fh;
        }
    };
    # be no-op ed by Acme::AtIncPolice
    push @INC, "lib";

cpanfile  view on Meta::CPAN

requires 'perl', '5.008001';
requires 'Tie::Trace';

on 'test' => sub {
    requires 'Test::More', '0.98';
    requires 'Test::Exception';
};

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

use strict;
use warnings;
use Carp;

our $VERSION = "0.02";

BEGIN {
    use Tie::Trace qw/watch/;
    no warnings 'redefine';

    *Tie::Trace::_output_message = sub {
        my ($self, $class, $value, $args) = @_;
        if (!$value) {
            return;
        }

        my ($msg, @msg) = ('');

        my $caller    =  $self->{options}->{caller};
        my $_caller_n = 1;
        while (my $c = (caller $_caller_n)[0]) {

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

                return("$msg => $value$location");
            }else{
                return("${msg}[$args->{point}] => $value$location");
            }
        } elsif ($class eq 'Hash') {
            return("${msg}" . (! $self->{options}->{pkg} || @msg ? "" : " => "). "{$args->{key}} => $value$location");
        }
    };


    *Tie::Trace::_carpit = sub {
        my ($self, %args) = @_;
        return if $Tie::Trace::QUIET;
        
        my $class = (split /::/, ref $self)[2];
        my $op = $self->{options} || {};
        
        # key/value checking
        if ($op->{key} or $op->{value}) {
            my $key   = $self->_matching($self->{options}->{key},   $args{key});
            my $value = $self->_matching($self->{options}->{value}, $args{value});

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

            $watch_msg = sprintf("%s:: %s", @{$self->{options}}{qw/pkg var/});
        } else {
            $msg =~ s/^ => // if $msg;
        }
        if ($msg) {
            croak $watch_msg . $msg . "\n";
        }
    };

    watch @INC, (
        debug => sub {
            my ($self, $things) = @_;
            for my $thing (@$things) {
                my $ref = ref($thing);
                if ($ref) {
                    return "Acme::AtIncPolice does not allow contamination of \@INC";
                }
            }
        },
        r => 0,
    );

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

=encoding utf-8

=head1 NAME

Acme::AtIncPolice - The police that opponents to @INC contamination

=head1 SYNOPSIS

    use Acme::AtIncPolice;
    # be killed by Acme::AtIncPolice
    push @INC, sub {
        my ($coderef, $filename) = @_;
        my $modfile = "lib/$filename";
        if (-f $modfile) {
            open my $fh, '<', $modfile;
            return $fh;
        }
    };
    # be no-op ed by Acme::AtIncPolice
    push @INC, "lib";

t/10_acme.t  view on Meta::CPAN

use strict;
use Test::More;
use Test::Exception;
use Acme::AtIncPolice;

lives_ok(sub {push @INC, "lib"}, "Acme::AtINCPolice no says");

throws_ok(sub {
    push @INC, sub {
        my ($coderef, $filename) = @_;
        my $modfile = "lib/$filename";
        if (-f $modfile) {
            open my $fh, '<', $modfile;
            return $fh;
        }
    };
}, qr/^Acme::AtIncPolice does not allow contamination of \@INC/);

done_testing;