view release on metacpan or  search on metacpan

lib/Acme/BeyondPerl/ToSQL.pm  view on Meta::CPAN

sub import {
	my $class = shift;
	my %hash  = %{ $_[0] } if(@_ == 1);
	my ($dsn, $user, $pass, $opt) = (@_ > 1) ? @_ : @{$hash{dbi}};

	_connect($dsn, $user, $pass, $opt) unless($Dbh);

	_overload();

	overload::constant (
		integer => \&_integer_handler,
		float   => \&_float_handler,
	);

	if(defined $hash{debug}){ $DEBUG = $hash{debug}; }

}


my $OPs = {
	'+'    => sub { shift->add(@_) },
	'-'    => sub { shift->sub(@_) },
	'*'    => sub { shift->mul(@_) },
	'/'    => sub { shift->div(@_) },
	'%'    => sub { shift->mod(@_) },
	'**'   => sub { shift->pow(@_) },
	'log'  => sub { shift->log(@_) },
	'sqrt' => sub { shift->sqrt(@_)},
	'abs'  => sub { shift->abs(@_) },
	'cos'  => sub { shift->cos(@_) },
	'sin'  => sub { shift->sin(@_) },
	'exp'  => sub { shift->exp(@_) },
	'atan2'=> sub { shift->atan2(@_) },
	'<<'   => sub { shift->lshift(@_) },
	'>>'   => sub { shift->rshift(@_) },
	'&'    => sub { shift->and(@_) },
	'|'    => sub { shift->or(@_)  },
	'^'    => sub { shift->xor(@_) },
};


sub ops { return $OPs; }

sub Type { $Type; }

##############################################################################

sub _connect {
	my ($dsn, $user, $pass, $opts) = @_;

	$Dbh = DBI->connect($dsn, $user, $pass, $opts) or die $!;

	$Type = ($dsn =~ /dbi:(\w+)/)[0];
}


sub _overload {
	my $mod = __PACKAGE__ . '::' . $Type;

	eval qq| require $mod |;
	if($@){ croak "Can't load $mod."; }

	my $ops = $mod->ops;
	my %operators = (
		nomethod => \&_nomethod,
		'""'   => sub { ${$_[0]} },
		'<=>'  => sub { ${$_[0]} <=> ${$_[1]} },
		'0+'   => sub { ${$_[0]} },
		'bool' => sub { ${$_[0]} },
		'cmp'  => sub { ${$_[0]} cmp ${$_[1]} },
		%{ $ops }
	);

	eval q| use overload %operators |;
	if($@){ die $@; }

}


sub _integer_handler {
	my ($ori, $interp, $contect) = @_;
	return bless \$interp, __PACKAGE__ . "::$Type\::__Integer";
}

sub _float_handler {
	my ($ori, $interp, $contect) = @_;
	return bless \$interp, __PACKAGE__ . "::$Type\::__Float";
}


##############################################################################
# Use From Objects
##############################################################################

sub _calc_by_rdbm {
	if($DEBUG){ print "$_[0]\n"; }
	_float_handler( undef, $Dbh->selectrow_array($_[0]) );
}


sub _nomethod {
	my ($x, $y, $swap, $op) = @_;
	croak "This operator '$op' is not implemented in $Type";
}


sub _get_args {
	my ($x, $y, $swap) = @_;
	if($swap){ ($x, $y) = ($y, $x) }
	$x = $x->as_sql if(UNIVERSAL::can($x,'as_sql'));
	$y = $y->as_sql if(UNIVERSAL::can($y,'as_sql'));
	return ($x,$y);
}

sub _get_args_as_bits {
	my ($x, $y, $swap) = @_;
	if($swap){ ($x, $y) = ($y, $x) }
	$x = $x->as_bit if(UNIVERSAL::can($x,'as_sql'));
	$y = $y->as_bit if(UNIVERSAL::can($y,'as_sql'));
	return ($x,$y);
}

sub as_sql { ${$_[0]} }

sub as_bit { ${$_[0]} }

##############################################################################
# OPERATORS
##############################################################################

sub add {
	my ($x, $y) = _get_args(@_);
	_calc_by_rdbm("SELECT $x + $y");
}