view release on metacpan or  search on metacpan

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

    _update_mask($file, $line, $_, $mask) for @subs;
    return;
}

sub mask_call {
    my $mask = shift;
    my $sub = shift;
    my ($pkg, $file, $line) = caller(0);

    _validate_mask($mask);

    $sub = $pkg->can($sub) if $sub && !ref($sub);

    croak "The second argument to mask_call() must be a coderef, or the name of a sub to call"
        unless $sub && ref($sub) && reftype($sub) eq 'CODE';

    _update_mask($file, $line, $sub, $mask);

    @_ = (@_);    # Hide the shifted args
    goto &$sub;
}

sub mask_sub {
    my ($mask, $sub, $file, $line) = @_;
    $file ||= '*';
    $line ||= '*';

    _validate_mask($mask);

    $sub = caller->can($sub) if $sub && !ref($sub);

    croak "The second argument to mask_sub() must be a coderef, or the name of a sub in the calling package"
        unless $sub && ref($sub) && reftype($sub) eq 'CODE';

    my $name = _subname($sub);
    croak "mask_sub() cannot be used on an unamed sub"
        if $name =~ m/__ANON__$/;

    _update_mask($file, $line, $name, $mask);
    return;
}

sub mask_frame {
    my %mask = @_;

    _validate_mask(\%mask);

    my ($pkg, $file, $line, $name) = caller(1);
    _update_mask($file, $line, $name, \%mask);

    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;
    return { map { %{$_} } @order };
}

1;

__END__

=pod

=head1 NAME

Trace::Mask::Util - Utilities for applying stack trace masks.

=head1 DESCRIPTION

This package provides utilities to help you apply masks for stack traces. See
L<Trace::Mask> for the specification these utilities follow.

=head2 EXPORTS

B<Note:> All exports are optional, you must request them if you want them.

=over 4

=item update_mask($file, $line, $sub, \%mask)

Update the mask for the specified C<$file>, C<$line>, and C<$sub>. The mask
hashref will be merged into any existing mask. You may use the wildcard string
C<'*'> for any 2 of the first 3 arguments. C<$sub> may be coderef, or a fully
qualified sub name.

=item @errors = validate_mask(\%mask)

This will check the mask to ensure it is valid. If the mask is valid an empty
list is returned. If there are problems with the mask then a list of error
strings will be returned.

=item $hr = get_mask($file, $line, $sub)

Get the combined mask for the specific file, line and sub. This will be a
merger of all applicable masks, including wildcards. C<$sub> may be a coderef,
or a fully qualified sub name.

=item mask_call(\%mask, $sub)

=item mask_call(\%mask, $sub, @args)

This will call C<$sub> with the specified mask and arguments. This will use
C<goto &$sub> to run your sun without C<mask_call()> itself showing up in any
stack frames. C<$sub> can be a sub reference, or the name of a sub in the