#!/usr/bin/perl

# #################################################################
#
# Filename:    oradbi_transactions.pl
#
# Version:     1.0
#
# Autor:       Akadia AG, Martin Zahn 29.11.1998
#
# Purpose:     This perl scripts connects to Oracle-8 using
#              the perl module DBD::ORACLE, creates a table
#              using the DO method, inserts some records and
#              selects them after inserting.
#
# Environment: SQL*NET must be configured
#
# #################################################################

use strict;   # Each variable must be declared
use English;  # We can use full names for special variables like @$
use DBI;      # We need the perl module DBI

my $dbh = DBI->connect ('dbi:Oracle:RAB1',
                        'scott',
                        'tiger',
                       ) || die "Database connection failed: $DBI::errstr";

# Options for the dbh handle:
# - AutoCommit, which when true will automatically commit database
#   transactions (we don't like this behavior !).
# - RaiseError, which tells DBI to croak $DBI::errstr upon errors.
# - PrintError, which tells DBI to warn $DBI::errstr

$dbh->{AutoCommit} = 0;  # Turn AutoCommit off for transactions
$dbh->{PrintError} = 1;  # Turn warnings on (DEFAULT)
$dbh->{RaiseError} = 0;  # First to not abort an failures (DROP ...)

# DROP and CREATE TABLE employees, usually this is done
# using the do() call.

my $sql = qq { DROP TABLE employees CASCADE CONSTRAINTS };
$dbh->do($sql);           # Do not catch the error

$dbh->{RaiseError} = 1;   # Now abort an failures

$sql = qq {CREATE TABLE employees (
                   id     INTEGER         NOT NULL,
                   name   VARCHAR2(128)   NULL,
                   title  VARCHAR2(128)   NULL,
                   phone  VARCHAR2(128)   NULL)};
$dbh->do($sql);
if ($DBI::err) {
    print (STDERR "Error: " . $DBI::errstr . "\n");
    exit;
}

# Now load some records in the database. First we
# fill a array-of-array named @records with some
# records (see Programming Perl page 265).

my @records = (
  [0,"Martin Zahn",    "Author of this script",   "++41 33 345 02 40"],
  [1,"Rene Steiner",   "Author of Matti Tool",    "++41 31 385 30 15"],
  [2,"Beat Jucker",    "HLR and TCL Guru",        "++41 31 385 30 16"],
  [3,"Martin Müller",  "Sniff-Responsible",       "++41 31 385 30 18"]);

# Print Element [2][2]

print (STDOUT "Element [2][2] = $records[2][2]\n\n");

# Next we read the records from a file and push them
# in the same array-of-array @records

open (ADDRESS,"<adresslist.txt") || die ("Can't open adresslist.txt: $!");
while (my $line = <ADDRESS>) {
  chomp ($line);
  my @tmp = split (";",$line);
  push (@records, [@tmp]);
}

# Next we print each record in the array-of-array @records with refs

my $array_ref;
for $array_ref (@records) {
  print (STDOUT "\t [@$array_ref],\n");
}
print (STDOUT "\n");

# The array-of-array @records is now ready for the
# INSERT statement. To implement robust transactions with DBI,
# according to the DBI documentation, is to use the eval {....}
# blocks to trap errors, then use commit or rollback to
# finish the transaction.

my $sql = qq {INSERT INTO employees VALUES (?, ?, ?, ?)};
my $sth = $dbh->prepare($sql);
if ($DBI::err) {
    print (STDERR "Error: " . $DBI::errstr . "\n");
    exit;
}

foreach my $i (@records) {
  eval {
    $sth->bind_param (1, @$i->[0], $DBI::SQL_INTEGER);  # id
    $sth->bind_param (2, @$i->[1], $DBI::SQL_VARCHAR);  # name
    $sth->bind_param (3, @$i->[2], $DBI::SQL_VARCHAR);  # title
    $sth->bind_param (4, @$i->[3], $DBI::SQL_VARCHAR);  # phone
    $sth->execute();
    $dbh->commit;
  };
  if ($EVAL_ERROR) {     # $EVAL_ERROR is the same as $@ operator
    warn "Database error: $DBI::errstr\n";
    $dbh->rollback();    # Die if rollback is failing
  }
}

# Finish INSERT, calling finish() is not strictly necessary,
# call it if you are done with the statement handle,
# but not with your program.

$sth->finish(); 

# Now SELECT the records using bind_columns() to get the
# records out of the database. Bind_columns() binds each column
# to a scalar reference. When fetch() is called those scalars
# are filled with the values from the database

my $sql = qq { SELECT name,title,phone FROM employees }; 
$sth = $dbh->prepare($sql);
$sth->execute();

my ($id,$name,$title,$phone);
$sth->bind_columns (undef,\$name,\$title,\$phone);

while ($sth->fetch()) {
  print (STDOUT "$name, $title, $phone\n");
}
print (STDOUT "\n\n");
$sth->finish(); # Finishing SELECT

# Now we want to print out only some records using
# a WHERE clause. We will use bind_param() to prepare
# an SQL statement one time, and execute it several time
# very quickly.

# Prepare WHERE clause, show only "Zahn" and "Steiner"

my @names = ("%Zahn%","%Steiner%");  # % Here, "%" is the oracle wildcard !
my $where;

my $sql = qq { SELECT id,name,title,phone 
                 FROM employees
                WHERE name LIKE ? }; 
$sth = $dbh->prepare($sql);

# Loop through names array and bind each array value
# to the WHERE clause.

foreach $where (@names) {
  $sth->bind_param (1,$where,$DBI::SQL_VARCHAR);
  $sth->execute();
  
  my ($id,$name,$title,$phone);
  $sth->bind_columns (undef,\$id,\$name,\$title,\$phone);

  while ($sth->fetch()) {
    print (STDOUT "$id, $name, $title, $phone\n");
  }
}
$sth->finish(); # Finishing SELECT

$dbh->disconnect(); # Avoid the error "Database handle destroyed without
                    # explicit disconnect".