ORA_PERL.pm

strict;

use warnings;

use DBI;

package ORA_PERL;

sub new {
  my $self = {};

  $self -> {error_out_proc} = \&error_out_proc;

  bless $self, shift;

  # print $_[$#_];

  $self->connect(@_) if $#_ >= 2;

  return $self;
}

sub connect {
  my $self   = shift;

  my ($user,$pw,$instance,$sysdba)=@_;

  my $params = {};

  $params -> {ora_session_mode} = 2 if $sysdba;

  $self -> {dbh} = DBI->connect("dbi:Oracle:$instance",$user,$pw, $params);

  &{$self->{error_out_proc}} ($DBI::errstr) if $DBI::errstr;
}


sub stmt {
  my $self = shift;
  my $stmt = shift;

  $self -> {dbh} -> do ($stmt);

  print $self->{dbh}->errstr if $self->{dbh}->errstr;
}

# the name of the param must be :param
sub bind_inout {
  my $self = shift;
  my $stmt = shift;

  my $sth = $self -> {dbh} -> prepare ($stmt);

  $sth -> bind_param_inout(":param", \$_[0], length $_[0]);

  $sth -> execute;
}


# use this method to select a single value (such as select count(*) from x, or select y where z=3 or so
sub single {
  my $self = shift;
  my $stmt = shift;
  
  my $sth = $self -> {dbh} -> prepare($stmt);
  print $self->{dbh}->errstr if $self->{dbh}->errstr;

  $sth -> execute;
  print $sth -> errstr if $sth -> errstr;

  return ($sth->fetchrow_array)[0];
}


# Use this to select a single row
sub single_row {
  my $self = shift;
  my $stmt = shift;
  
  my $sth = $self -> {dbh} -> prepare($stmt);
  print $self->{dbh}->errstr if $self->{dbh}->errstr;

  $sth -> execute;
  print $sth -> errstr if $sth -> errstr;

  return $sth->fetchrow_array;
}

#
#
# use single_col as shows:
#
# for my $x ($o -> single_col("select x from y")) {
#   print $x;
# }
sub single_col {
  my $self = shift;
  my $stmt = shift;

  return @{$self -> {dbh} -> selectcol_arrayref($stmt)};
}

sub error_out_proc {
  #my $self   = shift;
  my $errstr = shift;

  print "\n## $errstr\n";
}

# Returns a resultset: (ORA_PERL_RS)
#
# Use it like this:
#
#   my $rs = $o->rs($stmt);
#   while (my @column_values = $rs->next) {
#     ...
#   }
sub rs {
  my $self = shift;
  my $stmt = shift;

  my $rs = ORA_PERL_RS->new($self,$stmt);
  return $rs;
}

1;

package ORA_PERL_RS;

sub new {
  my $self = {};
  my $g = shift;

  bless $self, $g;

  my $o    = shift;
  my $stmt = shift;

  $self -> {error_out_proc} = $o->{error_out_proc};

  $self->{sth} = $o->{dbh} -> prepare($stmt);

  &{$self->{error_out_proc}} ($o->{dbh}->errstr) if $o->{dbh}->errstr;

  $self->{sth} -> execute;


  &{$self->{error_out_proc}} ($self->{sth}->errstr) if $self->{sth}->errstr;

  return $self;
}

sub next {
  my $self = shift;
  return $self->{sth}->fetchrow_array;
}

1;