File Coverage

blib/lib/RPC/Oracle.pm

Criterion	Covered	Total	%
statement	0	74	0.0
branch	0	32	0.0
condition	0	3	0.0
subroutine	0	7	0.0
pod	5	5	100.0
total	5	121	4.1

package RPC::Oracle;

our $VERSION = '1.3';

sub new {
	my ($self, $class, $dbh, $schema) = ({}, @_);
	$self = bless $self, $class;

    $self->schema($schema);

	$self->dbh($dbh);
	return $self;
}

sub dbh {
	my ($self, $dbh) = @_;
	if(@_ == 2) {
		$self->{dbh} = $dbh;
		return $self;
	}
	return $self->{dbh};
}

sub schema {
	my ($self, $schema) = @_;
	if(@_ == 2) {
		$self->{schema} = $schema;
		return $self;
	}
	return $self->{schema};
}

sub call {
	my ($self, $method, @args) = @_;

	die "Invalid identifier: $method"
		unless $self->_check_identifier($method);

	if(! $self->dbh) {
		die "No database handle";
	}

	my $sql = "BEGIN ";
	my @bind = ();
	my $return;

	# if not called in void context (list or scalar), call as function
	if(defined wantarray) {
		$sql .= " ? := ";
		push @bind, \$return;
	}

	# prefix the schema name if set
	if($self->schema) {
		$method = $self->schema . ".$method";
	}

    $sql .= "$method";
    if(@args > 0) {
        $sql .= "(";

        # bind as name-based parameters
        if(@args == 1 && ref $args[0] eq 'HASH') {
            my $first = 1;
            while(my($var_name, $var_value) = each(%{ $args[0] })) {
                $sql .= $first ? "" : ", ";
                $sql .= "$var_name => ?";
                push @bind, $var_value;

                $first = 0;
            }
        }
        else {
            $sql .= join(', ', ('?') x scalar(@args));
            push @bind, @args;
        }
        $sql .= ")";
    }
	$sql .= "; END;";

	my $sth = $self->dbh->prepare($sql);
	my $i = 1;
	for my $bindvar (@bind) {
		if(ref $bindvar) {
			$sth->bind_param_inout($i, $bindvar, $self->dbh->{LongReadLen});
		}
		else {
			$sth->bind_param($i, $bindvar);
		}
		$i++;
	}

	$sth->execute;

	return $return;
}

sub constant {
	my ($self, $constant_name) = @_;

	die "Usage: constant('constant_name')" unless $constant_name;

	die "Invalid identifier: $constant_name"
		unless $self->_check_identifier($constant_name);

	# return from cache if available
	if($self->{uc $schema}->{uc $constant_name}) {
		return $self->{uc $schema}->{uc $constant_name};
	}

	die "No database handle"
		unless $self->dbh;

	my $sql = "BEGIN ? := ";
	my $schema = $self->schema;
	$sql .= $schema ? "$schema.$constant_name" : $constant_name;
	$sql .= "; END;";

	my $sth = $self->dbh->prepare($sql);
	my $value;
	$sth->bind_param_inout(1, \$value, $self->dbh->{LongReadLen});

	$sth->execute;

	# cache this for later
	$self->{uc $schema}->{uc $constant_name} = $value;

	return $value;
}

sub _check_identifier {
	my ($self, $ident) = @_;
	return $ident =~ /^[a-z][a-z0-9\$\#\_\.]*$/i;
}

sub AUTOLOAD {
	my ($self, @args) = @_;
	my $sub = $AUTOLOAD;
	$sub =~ s/.*:://;
	return if $sub eq 'DESTROY';

	return $self->call($sub, @args);
}

1;

__END__