Trace-Mask

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

    You can use this to replace the package, file, etc. This will work for
    any VALID index into the list. This cannot be used to extend the list.
    Numeric keys outside the bounds of the list are simply ignored, this is
    for compatability as different perl versions may have a different size
    list.

  SPECIAL/MAGIC subs
    Traces must NEVER hide or alter the following special/magic subs:

    BEGIN
    UNITCHECK
    CHECK
    INIT
    END
    DESTROY
    import
    unimport

    These subs are all special in one way or another, hiding them would be
    hiding critical information.

README.md  view on Meta::CPAN

the package, file, etc. This will work for any VALID index into the list. This
cannot be used to extend the list. Numeric keys outside the bounds of the list
are simply ignored, this is for compatability as different perl versions may
have a different size list.

## SPECIAL/MAGIC subs

Traces must NEVER hide or alter the following special/magic subs:

- BEGIN
- UNITCHECK
- CHECK
- INIT
- END
- DESTROY
- import
- unimport

These subs are all special in one way or another, hiding them would be hiding
critical information.

lib/Trace/Mask.pm  view on Meta::CPAN

=head2 SPECIAL/MAGIC subs

Traces must NEVER hide or alter the following special/magic subs, they should
be considered the same as any C<lock> frame.

=over 4

=item BEGIN

=item UNITCHECK

=item CHECK

=item INIT

=item END

=item DESTROY

=item import

lib/Trace/Mask/Util.pm  view on Meta::CPAN

    return;
}

sub get_mask {
    my ($file, $line, $sub) = @_;

    my $name = ref($sub) ? _subname($sub) : $sub;

    my $masks = _MASKS();

    return {lock => $1} if $sub =~ m/(?:^|:)(END|BEGIN|UNITCHECK|CHECK|INIT|DESTROY|import|unimport)$/;

    my @order = grep { defined $_ } (
        $masks->{$file}->{'*'}->{'*'},
        $masks->{$file}->{$line}->{'*'},
        $masks->{'*'}->{'*'}->{$name},
        $masks->{$file}->{'*'}->{$name},
        $masks->{$file}->{$line}->{$name},
    );

    return {} unless @order;

t/special.t  view on Meta::CPAN

sub do_trace { trace() }     my $trace_line    = __LINE__;

BEGIN        { $begin     = trace_end() };
CHECK        { $check     = trace_end() };
INIT         { $init      = trace_end() };
sub import   { $import    = trace_end() };
sub unimport { $unimport  = trace_end() };

my $f = __FILE__;
my $l = __LINE__ + 1;
my $uc = eval "#line $l \"$f\"\nUNITCHECK { \$unitcheck = trace_end() }; 1";

my $x = 0;
sub DESTROY {
    return if $x++;
    $destroy = trace_end()
}

my $file = __FILE__;
main->import;
main->unimport;

t/special.t  view on Meta::CPAN

        DNE(),
    ],
    "BEGIN trace"
);

like(
    $unitcheck,
    [
        [[__PACKAGE__, __FILE__, $trace_line,    'Trace::Mask::Reference::trace'], [], {}],
        [[__PACKAGE__, __FILE__, $do_trace_line, 'main::do_trace'],                [], {}],
        [[__PACKAGE__, __FILE__, $any,           'main::UNITCHECK'],               [], {lock => 'UNITCHECK'}],
        DNE(),
    ],
    "UNITCHECK trace"
) if $uc;

like(
    $check,
    [
        [[__PACKAGE__, __FILE__, $trace_line,    'Trace::Mask::Reference::trace'], [], {}],
        [[__PACKAGE__, __FILE__, $do_trace_line, 'main::do_trace'],                [], {}],
        [[__PACKAGE__, __FILE__, $any,           'main::CHECK'],                   [], {lock => 'CHECK'}],
        DNE(),
    ],