view release on metacpan or  search on metacpan

Snark.pm  view on Meta::CPAN

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__
# Below is the stub of documentation for your module. You better edit it!
# And if I don't?  Who ya gonna tell?

=head1 NAME