File: early1_x.pm

package info (click to toggle)
libdevel-declare-perl 0.006017-1%2Bdeb8u1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-updates
  • size: 428 kB
  • ctags: 249
  • sloc: ansic: 752; perl: 608; makefile: 2
file content (24 lines) | stat: -rw-r--r-- 746 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
package t::early1_x;
use strict;
use warnings;
sub import {
    require Devel::Declare;
    my $caller = caller();
    no strict 'refs';
    *{ "${caller}::class" } = sub (&) { $_[0]->() };
    Devel::Declare->setup_for($caller, {
        class => {
            const => sub {
                my ($kw, $off) = @_;
                $off += Devel::Declare::toke_move_past_token($off);
                $off += Devel::Declare::toke_skipspace($off);
                die unless substr(Devel::Declare::get_linestr(), $off, 1) eq '{';
                my $l = Devel::Declare::get_linestr();
                substr $l, $off + 1, 0, 'pass q[injected];' . (';' x 1000);
                Devel::Declare::set_linestr($l);
            },
        },
    });
}

1;