Trace-Mask

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
  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

226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
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

269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
 
=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

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
    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

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
        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(),
    ],