Tie::Function::Examples - tie functions to the the read side of hashes

 Tie::Function::Examples - tie functions to the the read side of hashes

 use Tie::Function::Examples;
 use Tie::Function::Examples qw(%thoucomma %nothoucomma %addcents %q_shell %round %sprintf);

 tie %array, 'Tie::Function::Examples', \&function;

	use Tie::Function::Examples;

	tie %double, 'Tie::Function::Examples', 
		sub {
			my ($key) = @_;
			return $key * 2 if $key != 0;
			return $key.$key;
		};

	print "2 * 2 is $double{2}\n";




	use Tie::Function::Examples qw(%thoucomma %addcents);

	tie %mymoney, 'Tie::Function::Examples',
		sub {
			my ($key, $underlying_array) = @_;
			return "\$$thoucomma{$addcents{$underlying_array->{$key}}";
		};

	$mymoney{joe} = 7000;
	print "$mymoney{joe}\n" # prints $7,000.00

package Tie::Function::Examples;

@ISA = qw(Tie::StdHash Exporter);
@EXPORT_OK = qw(%thoucomma %nothoucomma %addcents %q_shell %q_perl %round %sprintf %line_numbers);

require Tie::Hash;
require Exporter;
use Carp;
use strict;
use warnings;

our $VERSION = 0.42;

use strict;

tie our %q_perl, 'Tie::Function::Examples',
	sub {
		my ($string) = @_;
		$string =~ s/'/'."'".'/g;
		return "'$string'";
	};

tie our %q_shell, 'Tie::Function::Examples',
	sub {
		my ($file) = @_;
		return $file if $file =~ /^[-,_\.+=:\/0-9a-zA-Z]+$/;
		$file =~ s/'/'\\''/g;
		return "'$file'";
	};


tie our %sprintf, 'Tie::Function::Examples',
	sub {
		my ($format, @args) = split($; , $_[0]);
		return sprintf($format, @args);
	};

tie our %round, 'Tie::Function::Examples',
	sub {
		my ($amount, $scale) = split($; , $_[0]);
		require POSIX;
		$scale = 1 unless $scale;
		# scale = .01 for cents
		# scale = 1000 for thousands
		$amount /= $scale;
		$amount += .5;
		$amount = POSIX::floor($amount);
		$amount *= $scale;
		return $amount;
	};

tie my %decomma, 'Tie::Function::Examples',
	sub {
		my ($f) = @_;
		$f =~ s/,//g;
		return $f;
	};

tie our %nothoucomma, 'Tie::Function::Examples',
	sub {
		my ($number) = @_;
		$number =~ s/(\A|\D)(\d\d?\d?)(,\d\d\d)+(\D|\z)/$1$2$decomma{$3}$4/g;
		return $number;
	};

tie our %thoucomma, 'Tie::Function::Examples', 
	sub {
		my ($number) = @_;
		1 while ($number =~ s/(?<![\d.])(\d+)(\d\d\d)(?!\d)/$1,$2/g);
		return $number;
	};

tie our %addcents, 'Tie::Function::Examples',
	sub {
		my ($money) = @_;
		1 while ($money =~ s/(?<![\d.])(\d+)([^\d,.]|\z|,(?!\d))/$1.00$2/);
		1 while ($money =~ s/(?<![\d.])(\d+\.)([^\d,]|\z|,(?!\d))/${1}00$2/);
		1 while ($money =~ s/(?<![\d.])(\d+\.\d)([^\d,]|\z|,(?!\d))/${1}0$2/);
		$money =~ s/(\d+\.\d\d\d+)([^\d,]|\z|,(?!\d))/$sprintf{'%.2f', $1}$2/g;
		$money =~ s/(\d[\d,]+\.\d\d\d+)([^\d,]|\z|,(?!\d))/$thoucomma{$sprintf{'%.2f', $nothoucomma{$1}}}$2/g;
		return $money;
	};

tie our %line_numbers, 'Tie::Function::Examples',
	sub {
		my $text = shift;
		my @x = split(/\n/, $text);
		my $c = 0;
		return join("\n", map { sprintf("%-4d%s", $c++, $_) } @x);
	};

# 
#
#

sub TIEHASH
{
	my ($pkg, $func, @args) = @_;
	return bless [
		$func, 
		[@args],
		{},
	];
}

sub FETCH
{
	my ($self, $lookup) = @_;
	return &{$self->[0]}($lookup, $self->[2], @{$self->[1]});
}

sub STORE    { $_[0]->[2]{$_[1]} = $_[2] }
sub FIRSTKEY { my $a = scalar keys %{$_[0]->[2]}; each %{$_[0]->[2]} }
sub NEXTKEY  { each %{$_[0]->[2]} }
sub EXISTS   { exists $_[0]->[2]{$_[1]} }
sub DELETE   { delete $_[0]->[2]{$_[1]} }
sub CLEAR    { %{$_[0]->[2]} = () }

1;

__END__