[rochester-pm-list] sample cgi/oraperl script

[Alexander G. Macur]

First of Month while I'm running End of Month processing is really bad
for my

Attached is a something  I hacked up quick over lunch

I tested it on my sun. YMMV

good luck

--
alex

-------------- next part --------------
#!/export/home/mdc/bin/perl
#
# Quick hack to illustrate oraperl insert
#
# tested on
#
# Oraperl emulation interface version 1.39 
# DBD::Oracle 1.02 using OCI8 by Tim Bunce
# pandora$ perl -v
# This is perl, version 5.005_02 built for sun4-solaris
#
# pandora$ uname -a
# SunOS pandora 5.6 Generic_105181-14 sun4m sparc SUNW,SPARCstation-5


sub insert_data
  #
  # insert 1 record into the table
  #SQL> desc agm_test
  # Name                            Null?    Type
  # ------------------------------- -------- ----
  # CUSTOMER_NAME                   NOT NULL VARCHAR2(32)
  #
  # Inputs
  #  pDB - reference to hash containing db connection information
  #        username
  #        password
  #        system_id
  #  pCustomer - reference to hash containing customer information
  #              to insert
  #
  {
    use Oraperl;
    
    my $pDB = shift;
    my $pCustomer = shift;
    
    my $csr;
    my $istat;
    
    #
    # make sure we have some place to pass error messages back to CGI script
    #
    
    if ( ! $pDB->{pERROR} )
      {
        $pDB->{pERROR} = [];
      }
    
    my $pERR = $pDB->{pERROR};   
    #
    # sanity check arguments
    #
    if ( ! $pDB->{username} )
      {
        push @$pERR,"Oracle username may not be null";
        return 0;
      }
    if ( ! $pDB->{password} )
      {
        push @$pERR, "Oracle password may not be null";
        return 0;
      }
    if ( ! $pDB->{system_id} )
      {
        push @$pERR,"Oracle system id may not be null";
        return 0;
      }
    
    # 
    # can't pass SID in as parameter because of bizzare oracle 8 'feature'
    #
    $ENV{ORACLE_SID} = $pDB->{system_id};
    $pDB->{lda} = ora_login('',
                          $pDB->{username},
                          $pDB->{password});
    
    if ($ora_errno )
      {
        push @$pERR, $ora_errstr;
        return 0;
      }
    #
    # open up a cursor
    #
    my $sql = <<EOD;
    insert into agm_test
      ( 
       customer_name
      )
        values
          (
           :1
          )
EOD
              
              $csr = ora_open($pDB->{lda},$sql);
    
    if (( ! $csr ) || ( $ora_errno))
      {
        push @$pERR, $ora_errstr;
        return 0;
      }
    
    #
    # bind the cursor
    #
    $istat = ora_bind( $csr, $pCustomer->{name});

    if ( $ora_errno )
      {
        push @$pERR, $ora_errstr;
        return 0;
      }
   #
   #
   # commit
   #
    if ( ! ora_commit( $pDB->{lda} ))
      {
        push @$pERR, $ora_errstr;
        return 0;
      }

    #
    # log off
    #
    
      ora_logoff( $pDB->{lda} );

    if ($ora_errno)
    {
      push @$pERR, $ora_errstr;
      return 0;
    }      

    return 1;
  }

$SCCS="%Z%";
if ( $SCCS =~ /^@\(#\)/ )
{
    $CHECKED_IN = $CHECKED_IN = 'true';
    $MYVERSION = '%I%';
}
else
{
    $MYVERSION = '991202';
}

use CGI;

my $q = new CGI;
my @jourindx;

#
# oracle set up
#
if ( ! defined $ENV{ORACLE_HOME} )
{
    $ENV{ORACLE_HOME} = '/oradb/app/oracle/product/8.0.4';
}

print $q->header;

print $q->start_html('-title' => "sample CGI script ",
                     '-text' => "#000000",
                     '-link' => "#330099",
                     '-vlink' => "#003366",
                     '-author' => 'alex_macur at compuserve.com');
print $q->h3("Oraperl/DBI insert example");

print $q->startform;
print $q->b("Oracle User Id "),$q->textfield(-name=> 'username',
                                  -default=> ''),$q->br;

print $q->b("Oracle Password"),$q->password_field(-name=> 'password',
                                           -default=> ''),$q->br;

print $q->b("Oracle SID"),$q->textfield(-name=>'oracle_sid',
                                         -default=>''), $q->br;

print $q->b("Customer name");
print $q->textfield(-name=>'customer_name',
                    -size=>72,
                    -maxlength=>100,
                    -default=>''),
    $q->br;


print $q->submit(-name=>'Insert',
                 -value=>'Insert'),
    $q->reset,
    $q->br;


print $q->end_form;

if ( $q->param )
{
    
    my $errmsg;
    my $i;
    my $ier = 0;
    my $istat;
    my $jtc;
    my $nr;
    my $tmp;
    my %db;
    my %jourindx;
    my @error;
    my $sid;
    my %customer_data;

    $istat = 0;
    $db{perror} = \@error;


    $db{username} = $q->param('username');
    if ( $q->param('password') )
    { 
        $db{password} = $q->param('password');
    }
    else
    {
        $db{password} = $db{username};
    }

    if ( $q->param('oracle_sid') )
    { 
        $db{system_id} = $q->param('oracle_sid');
    }

    if ( $q->param('customer_name'))
      {
        $customer_data{name} = $q->param('customer_name');
      }

    if (( $istat = insert_data(\%db,
                             \%customer_data)))
    {
        print "<font color='green'>Record Inserted</font>",
        $q->br;
    }
    else
    {
        print $q->em("<font color='red'>Insert could not be completed</font>"),$q->br;
        $errmsg = join( '<BR>', @{$db{pERROR}} );
        $errmsg =~ s/\n/<BR>/g;
        print $q->em("ERROR: $errmsg");
    }
}

print $q->end_html;