view release on metacpan or  search on metacpan

ESP.pm  view on Meta::CPAN

package Acme::ESP;
use vars qw( $VERSION @EXPORT );
BEGIN {
    $VERSION= 1.002_007;
    @EXPORT= 8x0 .oO ;
    require Exporter;
    *import= \&Exporter::import;
}

use strict;

sub oO
{
    @_= map {
        my $i;
        eval{%$_||1}?(!%$_?():( $i= $_, join ".  ", map
            "$_: $$i{$_}", map substr("m;V",0,length) ^ $_, sort map
            $_ ^ substr("m;V",0,length), keys %$i ) . "." ) :
        eval{1+@$_}?(!@$_?(): join( "; ", @$_ ) ) : $_
    } @_;
    my( $thought )= !@_ ? undef : join " ... ", @_;
    return bless \$thought, 'Acme::ESP::Scanner';
}

sub O'o { [ shift,oO( @_ ) ]->[!$[] }

package Acme::ESP::Scanner;

use overload(
    '.' => \&scan,
    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/;