File Coverage

blib/lib/Var/Mystic.pm

Criterion	Covered	Total	%
statement	132	201	65.6
branch	26	54	48.1
condition	12	32	37.5
subroutine	24	27	88.8
pod			n/a
total	194	314	61.7

package Var::Mystic;

use 5.014; use warnings;

our $VERSION = '0.000003';

use Keyword::Declare;
use Data::Dx ();
use Variable::Magic qw< wizard cast >;

sub import {
    keyword track (          'here'?  $scoped,
                     /my|our|state/?  $declarator,
                   ScalarAccess|Var   $var,
                                '='?  $assignment
    ) {
        state $next_ID = 1;
        my $ID = 0;
        if ($scoped) {
            $ID = $next_ID++;
            $^H{"Var::Mystic tracker: $ID"} = 1;
        }

        my $sigil = substr($var,0,1);

        ( $declarator ? qq{$declarator $var;} : q{} )
        .
        ( $sigil eq '$' ? qq{ Var::Mystic::_scalar_setup(\\$var, '$var', $ID); }
        : $sigil eq '@' ? qq{  Var::Mystic::_array_setup(\\$var, '$var', $ID); }
        : $sigil eq '%' ? qq{   Var::Mystic::_hash_setup(\\$var, '$var', $ID); }
        :                 qq{BEGIN { die 'Cannot track $var'; }}
        )
        .
        ( $assignment ? qq{$var = } : q{} )
    }

    # Legacy interface...
    keyword mystic (Var $var) {{{ track my <{$var}> }}}
}

sub unimport {
    keyword track (          'here'?  ,
                     /my|our|state/?  $declarator,
                   ScalarAccess|Var   $var,
                                '='?  $assignment
    ) {
        return qq{$declarator $var = } if $declarator || $assignment;
        return  q{}
    }

    keyword mystic ()        {{{my}}}
}

sub _report {
    return if substr($_[1],-12) eq 'Data/Dump.pm';

    state $prev = q{};
    my    $dump = Data::Dump::dump($_[-1]);

    if ($dump ne $prev) {
        no warnings 'redefine';
        local *Term::ANSIColor::colored = -t *STDERR ? \&Term::ANSIColor::colored
                                                     : sub { return shift };
        Data::Dx::_format_data( @_ );
        $prev = $dump;
    }
    return;
}

sub _scalar_setup {
    my ($scalar_ref, $name, $ID) = @_;

    my (undef, $file, $line) = caller();

    cast ${$scalar_ref}, wizard
        set  => sub { my ($file, $line, $hints) = (caller 1)[1,2,10];
                      return if $ID && !exists $hints->{"Var::Mystic tracker: $ID"};
                      _report($line, $file, $name, q{}, ${$scalar_ref});
                    },
}

sub _array_setup {
    my ($array_ref, $name, $ID) = @_;

    my (undef, $file, $line) = caller();

    cast @{$array_ref}, wizard
        set   => sub { my ($file, $line, $hints) = (caller 1)[1,2,10];
                       return if $ID && !exists $hints->{"Var::Mystic tracker: $ID"};
                       cast my $result, wizard free => sub {
                            _report($line, $file, $name, q{}, $array_ref);
                       };
                       return \$result;
                     },
        clear => sub { my ($file, $line, $hints) = (caller 1)[1,2,10];
                       return if $ID && !exists $hints->{"Var::Mystic tracker: $ID"};
                       cast my $result, wizard free => sub {
                            _report($line, $file, $name, q{}, $array_ref);
                       };
                       return \$result;
                     },
}

sub _hash_setup {
    my ($hash_ref, $name, $ID) = @_;

    my (undef, $file, $line) = caller();

    cast %{$hash_ref}, wizard
        delete => sub { my ($file, $line, $hints) = (caller 1)[1,2,10];
                        return if $ID && !exists $hints->{"Var::Mystic tracker: $ID"};
                        cast my $result, wizard free => sub {
                            _report($line, $file, $name, q{}, $hash_ref);
                        };
                       return \$result;
                      },
        store  => sub { my ($file, $line, $hints) = (caller 1)[1,2,10];
                        return if $ID && !exists $hints->{"Var::Mystic tracker: $ID"};
                        cast my $result, wizard free => sub {
                             _report($line, $file, $name, q{}, $hash_ref);
                        };
                        return \$result;
                      },
        clear  => sub { my ($file, $line, $hints) = (caller 1)[1,2,10];
                        return if $ID && !exists $hints->{"Var::Mystic tracker: $ID"};
                        cast my $result, wizard free => sub {
                             _report($line, $file, $name, q{}, $hash_ref);
                        };
                        return \$result;
                      },
}



1; # Magic true value required at end of module
__END__