File Coverage

blib/lib/Acme/Snark.pm

Criterion	Covered	Total	%
statement	27	55	49.0
branch	11	14	78.5
condition	4	6	66.6
subroutine	9	23	39.1
pod			n/a
total	51	98	52.0

package Acme::Snark;

use strict;
use vars qw($VERSION);
$VERSION = '0.04';

my %stash;

sub TIESCALAR {
    my $foo;
    return bless \$foo, 'Acme::Snark';
}

sub FETCH {
    my $t_obj = {value => ${$_[0]} };
    bless($t_obj, 'Acme::Snark::HONK');
    return $t_obj;
}

sub STORE {
    if (defined($_[1]) && !$_[1]) {
	$stash{'>' . $_[1] . '<'}++;
    }
    elsif (!defined($_[1])) {
	$stash{'<>'}++;
    }
    ${$_[0]} = $_[1];
}

package Acme::Snark::HONK;

use overload
    q{bool} => sub {
	if (defined($_[0]->{value}) && !$_[0]->{value}) {

	    return $stash{'>'.$_[0]->{value}.'<'} > 2 ? 1 : $_[0]->{value};
	}
	elsif (!defined($_[0]->{value})) {
	    return $stash{'<>'} > 2 ? 1 : 0;
	}
	else {
	    return $_[0]->{value};
	}
    },
    '+' => sub {my @a=&rev; $a[0] + $a[1]},
    '-' => sub {my @a=&rev; $a[0] - $a[1]},
    '/' => sub {my @a=&rev; $a[0] / $a[1]},
    '*' => sub {my @a=&rev; $a[0] * $a[1]},
    '**' => sub {my @a=&rev; $a[0] **$a[1]},
    '.' => sub {my @a=&rev; $a[0] . $a[1]},
    '%' => sub {my @a=&rev; $a[0] % $a[1]},
    'x' => sub {my @a=&rev; $a[0] x $a[1]},
    '&' => sub {my @a=&rev; $a[0] & $a[1]},
    '^' => sub {my @a=&rev; $a[0] ^ $a[1]},
    '|' => sub {my @a=&rev; $a[0] | $a[1]},
    '<=>' => sub {my @a=&rev; $a[0]<=>$a[1]},
    'cmp' => sub {my @a=&rev; $a[0]cmp$a[1]},
    q{+0} => sub {$_[0]->{value}},
    q{""} => sub {$_[0]->{value}},
    ;

sub rev {
    if ($_[2]) {
	return ($_[1], $_[0]->{value});
    }
    else {
	return ($_[0]->{value}, $_[1]);
    }
}

1;
__END__