view release on metacpan or  search on metacpan

ESP.pm  view on Meta::CPAN

    nomethod => \&explode,
);

use vars qw( $openMind $fmt @fail );
#_init(); sub _init {    # (Just for Devel::Cover's sake)
    $openMind= 1<<25;
    {
        my $think= "thoughts";
        my $mind= \$think;
        my( $p2, $rc, $f )=
            unpack "LLL", unpack "P12", pack "L", $mind;
        my $state= unpack "C", pack "V", $f;
        my $nv= eval { length pack "F", 1.0 } || 8;
        my $pad= $nv - 4;
        if(  $state == 4  ) {
            $openMind >>= 4;
            $pad= 0;
        }
        if(  $openMind & $f  ) {
            die "Closed minds appear open (", log($openMind)/log(2), ").\n";
        }
        substr( $$mind, 0, 3, "" );
        ( $p2, $rc, $f )=
            unpack "LLL", unpack "P12", pack "L", $mind;
        if(  ! $openMind & $f  ) {
            warn "Warning: Open minds appear closed.\n"
                if  $^W;
        }
        my $size= eval { length( pack "J", 1 ) };
        my $last= "J";
        if(  ! defined $size  ) {
            $last= "L";
        } elsif(  4 < $size  ) {
            $last= "x4J"
                if  0 == $pad % 8;
        }
        ##@fail= 'Testing';
        while(  1  ) {
            my $pre= $pad ? "x$pad" : '';
            $fmt= $pre . "L3" . $last;
            my( $pv, $cur, $siz, $iv )=
                unpack $fmt, unpack "P32", pack "L", $p2;
            last   if  3 == $iv;
            push @fail, sprintf "%s:%x<%x:%x", $fmt, $cur, $siz, $iv;
            die "Too much skepticism (@fail).\n"
                if  $last !~ s/x4//
                &&  $last !~ s/J$/L/;
        }
    };
    ##die;
#}

sub scan
{
    my( $scanner, $mind, $right )= @_;
    die "Attempt to read scanner's mind!\n"
        if  ! $right;
    $mind= \$_[1];
    my $secret= '';
    my( $p2, $rc, $f, $p3 )=
        unpack "L4", unpack "P16", pack "L", $mind;
    if(  $openMind & $f  ) {
        my( $pv, $cur, $siz, $iv )=
            unpack $fmt, unpack "P32", pack "L", $p2;
        $pv= $p3
            if  $fmt =~ /^x/;
        $secret= unpack "P$iv", pack "L", $pv-$iv;
    }
    bless $scanner, 'Acme::ESP';
    my $thought= $$scanner;
    if(  defined $thought  ) {
        # It is surprising how hard it can be to clear your mind.
        # It'd be nice to do this less destructively.
        my $surface= "$$mind";
        $$mind= undef;
        $$mind= $thought . $surface;
        substr( $$mind, 0, length($thought), "" );