Link to home
Start Free TrialLog in
Avatar of stevecamp
stevecamp

asked on

Perl/Oracle problem - trying to connect to an Oracle resource through Perl

Hi -

I am trying to port some scripts from an AIX 4.3 server to an AIX 5.2 box. I have a script that tries to make a connection to an Oracle instance using, I believe, DBD as the driver. The Oracle instance on the remote server is running version 7.3.4 while the Oracle product on the box making the connection is 9.2.1. Not sure if that is a problem or not as i'm inexperienced with Oracle and this type of situation. Anyway, when I try to run the script it fails with the following error:

<h1>Software error:</h1>
<pre>Usage: $class-&gt;connect([$dsn [,$user [,$passwd [,\%attr]]]]) at /opt/tools/perl5/lib/5.8.3/VANDAL.pm line 440
</pre>
<p>
For help, please send mail to this site's webmaster, giving this error message
and the time and date of the error.

</p>
[Thu Oct 28 09:59:46 2004] ticket.pl: Usage: $class->connect([$dsn [,$user [,$passwd [,\%attr]]]]) at /opt/tools/perl5/lib/5.8.3/VANDAL.pm line 440

The code segment in VANDAL.pm that is causing the error is :

sub getdbh {
my(%cfg) = %VANDAL::cfg;
my($dbh) = DBI->connect($cfg{"dbname"},
                    $cfg{"user"},
                    $cfg{"password"},
                    $cfg{"dbd"},{AutoCommit => 0});
$message = "Error connecting to database $cfg{'dbname'}, $DBI::errstr\n";
$tag     = "vantive:VANDAL:ERROR:dbconnect";
for $key (keys %ENV){
    $message .= "Env.var:$key  val:$env{$key} ";
}
diewithhonor(tag => $tag, message => $message) if (!$dbh);
return($dbh);
}

It seems to be indicating either the dbd driver is not working or is it maybe a syntax problem? If I need to include more information, please let me know. I hope my question is clear.

Thanks to anyone who can help


Avatar of gripe
gripe

It sounds like the %cfg hash you are getting from your VANDAL package is not being defined.. what happens when you try to print it or Data::Dumper->Dumper() it?
Avatar of stevecamp

ASKER

All I know is that the %cfg refers to a prior code segment:

sub initialize {

  my($tmp);

  if (debugopt("hostname")) {
    $hostname = debugopt("hostname");
  }
  else {
    chop($hostname = `/bin/hostname`);
  }
  $hostname =~ tr/A-Z/a-z/;

  $cfgfile = ".vanrc";
  if (-r ".vanrc." .$hostname) {
    $cfgfile = ".vanrc.$hostname";
  }
  $tmp = debugopt("cfgfile");
  if (($tmp ne "") && (-r $tmp)) {
     $cfgfile = $tmp;
  }
# Precedence 1.debugopt.cfgfile, 2.vanrc.host 3.vanrc
  %cfg = docfg($cfgfile);
  for $tmp (keys %cfg) {
    $cfg{$tmp} = debugopt("cfg.".$tmp) || $cfg{$tmp};
  }
  doenv(\%cfg);
  $initialized = 1;
  return(%cfg);

}

The .vanrc reference is just a plain text file containing the Oracle instance name and password etc. If you need me to post an entire code segment or provide anything more let me know. Thanks again for the reply.
Could you insert:

use Data::Dumper;

at the top of the file in question and then insert:

print Dumper(%cfg);

just after: my (%cfg) = %VANDAL::cfg;

Thanks
while you're at it, you should also do:

print Dumper(%VANDAL::cfg);

Please respond with the results of both
I tried what you suggested but it didn't print or dump anything different to the screen. Perhaps I should explain a little more - this is a small piece to an application. The application is basically a broswer-based message board and when a message is posted, it can have a ticket number included in the message. This ticket number is formatted into a hyperlink which points to a record in this Oracle database. So, people can not only view the message but also click the ticket number link attached with each post and view that ticket information through their browser. The link points to the ticket.pl script. The ticket.pl script calls VANDAL.pm and this module makes the connection to the database and prints the ticket information into the browser. Here is the code for ticket.pl:

***Start ticket.pl code***
# $|=1;

use VANDAL;
use CGI;
use CGI::Apache qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;

my($query) = new CGI;
my($ticket)  = $query->param("ticket");
$ticket =~ s/\D//g;
$ticket = "0" if ($ticket eq "");
my($sql) = "";
my(%info);
my($title) = "";
my(%cfg) = VANDAL::initialize();
my($dbh) = VANDAL::getdbh();
my(%items);
my(%audit);

VANDAL::gettimeintonorm($dbh);
my($type) = VANDAL::getticktype(ticket => $ticket, dbh => $dbh); $title = "Problem Report # $ticket" if ($type eq "issue"); $title = "Request Item # $ticket" if ($type eq "item"); $title = "Request # $ticket" if ($type eq "request");

my(%info) = VANDAL::gettickinfo(ticket => $ticket, type => $type, dbh => $dbh); print $query->header; print $query->start_html($title); print Dumper(%cfg);
my($name)  = "$info{'SWFIRSTNAME'} $info{'SWLASTNAME'}";
my($login) = $info{'SWLOGIN'};
my($phone) = sprintf "(%s)-%s",$info{'SWOFFICECODE'},$info{'SWOFFICEPHONEEXT'};
my($status) = $info{'SWSTATUS'};
my($dcreated) = $info{'SWDATECREATED'};

print qq |
<TABLE align=center width=90%>
 <TR><TD></TD><TD><B>Enter New Ticket Number</B></TD></TR>  <TR><TD><B>$title</B><BR></TD><TD><FORM ACTION="ticket.pl" METHOD=POST>
   <INPUT TITLE="Vantive Ticket Number" NAME="ticket" TYPE=TEXT size="7" Maxlength="7">
   <INPUT TYPE=SUBMIT NAME="New Ticket#" VALUE="New Ticket#">
   <INPUT TYPE=RESET NAME="Clear" VALUE="Clear">
  </TD></TR>
</TABLE>
<TABLE align=DEFAULT>
  <TR><TD Colspan=3 align=center width=50% ><B>Problem Reporter</B></TD></TR>
  <TR><TD>Name</TD><TD>Unix Login</TD><TD>Phone Number</TD></TR>
  <TR><TD><B>$name</B></TD><TD><B>$login</B></TD><TD><B>$phone</B></TD></TR>
</TABLE><BR>
|;

my($key);

if ($type eq "request") {
  my($priority) = $info{'SWPRIORITY'};
  print qq |
<TABLE align=center width=85%>
  <TR><TD>Status:<B>$status</B></TD><TD>Priority:<B>$priority</B></TD><TD>Date Entered:<B>$dcreated</B></TD></TR>
</TABLE><BR>
|;
  my(%items) = VANDAL::getitems(dbh => $dbh, ticket => $ticket);
  print "<TABLE align=center width=99% STYLE=\"border-collapse:collapse\" Border=thin \n";
  print "<TR><TD>Item ID</TD><TD>LoginID</TD><TD>Item Type</TD><TD>Item Requested</TD><TD>Action</TD><TD>Assigned To</TD><TD>SLA</TD></TR>\n";
  for $key (keys %items) {
    printf "<TR><TD><A HREF=\"ticket.pl?ticket=%s\">%s</TD><TD>%s</TD><TD>%s</TD><TD>%s</TD><TD>%s</TD><TD>%s</TD><TD>%s</TD></TR>\n", $key,$key, $items{$key}{'SWLOGIN'}, $items{$key}{'OXITEMTYPE'},
                  $items{$key}{'SWNAME'}, $items{$key}{'OXACTION'},
                  $items{$key}{'OXASSIGNEDTO'},$items{$key}{'OXSLADATE'};
  }
  print "</TABLE>\n";
  print $query->end_html;
  printf "<A HREF=\"audit.pl?ticket=%s\">Click here for Audit Trail info</A><BR>",$ticket;
  exit;
}
if ($type eq "issue") {
  $at     = $info{'OXASSIGNEDTO'};
  $ttype  = $info{'SWSPECIALTYTYPE'};
  $area   = $info{'SWPROBLEMAREA'};
  $detail = $info{'SWPROBLEMDETAIL'};
  $note   = $info{'SWNOTE'};
  $resolv = $info{'SWDATERESOLVED'};
  print qq |
<TABLE align=center width=99%>
  <TR><TD>Status:<B>$status</B></TD><TD>Group Assigned To:<B>$at</B></TD></TR>
  <TR><TD>Type:<B>$ttype</B></TD><TD>Area:<B>$area</B></TD><TD>Detail:<B>$detail</B></TD></TR>
  <TR><TD>Date Created:<B>$dcreated</B></TD><TD>Date Resolved:<B>$resolv</B></TD></TR> </TABLE><BR>
|;
  print qq |
<TABLE align=center width=99%>
  <TR><TD><B>Description:</B> $note</TD></TR> </TABLE><BR>
|;
  printf "<A HREF=\"notes.pl?ticket=%s\">Click here for Associated Notes</A><BR>",$ticket;
  printf "<A HREF=\"audit.pl?ticket=%s\">Click here for Audit Trail info</A><BR>",$ticket;
  print $query->end_html;
  exit;
}
if ($type eq "item") {
  $at     = $info{'OXASSIGNEDTO'};
  $ttype  = $info{'OXITEMTYPE'};
  $area   = $info{'SWNAME'};
  $action = $info{'OXACTION'};
  $just   = $info{'OXJUSTIFICATION'};
  $hcopy  = $info{'OXHARDCOPYSTATUS'};
  $approv = $info{'OXAPPROVALSTATUS'};
  $dateap = $info{'OXDATEAPPROVED'};
  $sla    = $info{'OXSLADATE'};
  $reqid  = $info{'OXACCREQID'};

  print qq |
<TABLE align=center width=99%>
  <TR><TD>Status:<B>$status</B></TD><TD>Group Assigned To:<B>$at</B></TD><TD><A HREF="ticket.pl?ticket=$reqid">Parent Request ID# $reqid</A></TD></TR>
  <TR><TD>Type:<B>$ttype</B></TD><TD>Description:<B>$area</B></TD><TD>SLA date:<B>$sla</B></TD></TR>
  <TR><TD>HardCopy Status: <B>$hcopy</B></TD><TD>Approval Status: <B>$approv</B></TD><TD>Date Approved: <B>$dateap</B></TD></TR> </TABLE><BR>
|;
  print qq |
<TABLE align=center width=99%>
  <TR><TD><B>Justification:</B> $just</TD></TR> </TABLE><BR>
|;
  printf "<A HREF=\"notes.pl?ticket=%s\">Click here for Associated Notes</A><BR>",$ticket;
  printf "<A HREF=\"audit.pl?ticket=%s\">Click here for Audit Trail info</A><BR>",$ticket; }

***End ticket.pl code***

Does this help? Thanks for your continued advice!
Are you sure the files that VANDAL is getting it's config from are in the right directory/spot and contain all of the same entries that were on your previous server? Could you post an example of that?

This is the file that VANDAL package uses (.vanrc):

***start .vanrc file***
dbname          vapr
user            swb
password        password
dbd             Oracle
env:oracle_home /oracle/app/oracle/product/7.3.4
ORACLE_HOME     /oracle/app/oracle/product/7.3.4
env:pwd /vantive/VANTIVE8/scripts
***end .vanrc file***

The env variables in the file relate to the path of Oracle on the DB server, not the local one. However, I did try it using the local settings and it made no difference.
If you need me to post the entire VANDAL.pm code, I can do that?
Yes, go ahead
As you can probably tell, I didn't write any of this - it's way above my head! I can just about tell what it's trying to do is all and I need to get it ported over pretty urgently - here is the code:

***start of VANDAL.pm

package VANDAL;
use DBI;
use Data::Dumper;
#
# $Id: VANDAL.pm,v 1.6 2000/05/12 18:26:38 tgiardin Exp tgiardin $ # $REVISION = '$Id: VANDAL.pm,v 1.6 2000/05/12 18:26:38 tgiardin Exp tgiardin $'; $VERSION  = '1.1';

#
# Abstract  VANDAL: VANtive Data Abstraction Layer  
#   This package will contain commonly used structures and configuration
#   settings for DBI scripts to gather info from Vantive/Oracle instance.
#   all getxxx  subs need a database handle opened before calling ($dbh)
#   if using a sub that uses a $dbh, must pass it as argument to support
#   apache mod_perl variable scoping between modules
#

#
#  What  : initializes all scripts with configuration settings  
#        form   key -whitespace- value
# to pass ENV   env:key -whitespace- value  
#         ENV set in script only
#  Input : nothing or setting an ENV variable = file with config info #  Output: ENV set, if applies, and a hash with environment properties
#Requires: $cfgfile or ENV{"VANDALDEBUG"} to point to config file for
#          Vantive Database. calls docfg()
# For ENV{"VANDALDEBUG"} to work must contain:" cfgfile=$filename "
#   Form :  initialize();
#


sub initialize {

  my($tmp);

  if (debugopt("hostname")) {
    $hostname = debugopt("hostname");
  }
  else {
    chop($hostname = `/bin/hostname`);
  }
  $hostname =~ tr/A-Z/a-z/;

  $cfgfile = ".vanrc";
  if (-r ".vanrc." .$hostname) {
    $cfgfile = ".vanrc.$hostname";
  }
  $tmp = debugopt("cfgfile");
  if (($tmp ne "") && (-r $tmp)) {
     $cfgfile = $tmp;
  }
 # Precedence 1.debugopt.cfgfile, 2.vanrc.host 3.vanrc
  %cfg = docfg($cfgfile);
  for $tmp (keys %cfg) {
    $cfg{$tmp} = debugopt("cfg.".$tmp) || $cfg{$tmp};
  }
  doenv(\%cfg);
  $initialized = 1;
  return(%cfg);
     
}

#
#   What  : reads configuration file sent to this process
#   Input : needs a valid filename,full path, with config info
#   Output: if applies, and a hash with config values
# Requires: the input argument to point to config file for
#          Vantive Database
#   Form  : %cfg = docfg($fullyqualifiedconfigfilename) ;
#

sub docfg  {
  my (%cfg,$key,$val,$tmp,$keyenv);
  open(CFG,$_[0]);
  while(<CFG>)
  {
    next if /^$/;
    next if /^#/;
    ($_) = split(/[#\n]/);
    while ($_ =~ /\\$/) {
      chop($_);
      $_ .= <CFG>;
      chop($_);
    }
    ($key,$val) = split(/\s+/,$_,2);
    $key =~ tr/A-Z/a-z/;
    $cfg{$key}=$val;
     
  }
  close(CFG);
  return(%cfg);
}

#
# doenv  = sets all environment variables from config hash possibly from docfg
# that have the form env:  for the key.
# Input    : none
# Output   : none
# Requires : a reference to a hash that holds config info from docfg();
# Form     :  doenv(\%cfg);
#

sub doenv {

  my($cfg) = @_;
  my($key, $tmp, $keyenv);
 
  for $key (keys %$cfg) {
 #Is $key an environment variable? [env|ENV]:X
    if ( $key =~ /^env:/) {  
       ($tmp,$keyenv) = split(/:/,$key,2);
       $keyenv =~ tr/a-z/A-Z/;
       $ENV{"$keyenv"} =  $$cfg{$key};
    }
  }
}

#
# The enviroment variable VANDALDEBUG can contain many
# "debug" options.  It returns 0 if the option is not set, 1 if it is
# and a value if the options is specified as opt=value.
#
# NOTE: you could change the enviroment variable inside one of your
# scripts.  I don't think that would be a good idea, but it's your
# script...
# Form:  $debugboolean = debugopt($opt);
# $opt = space separated variables, "x" -> "x='1' (true) ", "x=2" -> "x='2'"
#

sub debugopt {
 
  my($opt) = $_[0];
  my($DEBUG) = " ".$ENV{'VANDALDEBUG'}." ";
 
  if($DEBUG eq "") {
    return 0;
  }
  elsif($DEBUG =~ /\s$opt\s/i) {
    return 1;
  }
  elsif($DEBUG =~ /\s$opt=(\S+)\s/i) {
    return $1;
  }
  return 0;
}

sub runon  {

  my(@on) = @_ ;
  my($hostname) = $hostname;
  my($host);
  my($tmp) = (split(/\./,$hostname))[0];
 
  for $host (@on) {
    $host =~ tr/A-Z/a-z/;
    if (($host =~ /\./) && ($host eq $hostname)) {
      return 1;
    }
    elsif ($host eq $tmp) {
      return 1;
    }
  }
  return 0;
}

#
# What:  Gets type of ticket, Problem report, Access Request (old),
#        Access Request (New), Access Request Item
# Input: Ticket Number
# Output:"issue" if Problem Report, "item" if Access Request Item,
#        "request" if Access Request (New), "oldrequest: if
#        Access Request(old) (pre phaseII), else "missing"
# Requires: a database handle to be opened, and stored in $dbh
# Form :  $tickettype = getticktype(ticket => $ticketnum, dbh => $dbh);
#

sub getticktype {

  my(%args) = @_;
  my($ticket) = $args{"ticket"};
  my($dbh)    = $args{"dbh"};
  my($sql);
  my($sth);
  my($ref);
  my($tmp);

  $sql  = "select swhdcaseid from sw_hd_case where ";
  $sql .= " swhdcaseid = $ticket ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  $ref = $sth->fetchrow_hashref;
  $sth->finish;
  $tmp = $$ref{"SWHDCASEID"};
  return("issue") if ($tmp eq $ticket);

  $sql  = "select oxaccitemid from ox_acc_item where ";
  $sql .= " oxaccitemid = $ticket ";
  $sth  = $dbh->prepare($sql);
  $sth->execute;
  $ref = $sth->fetchrow_hashref;
  $sth->finish;
  $tmp = $$ref{"OXACCITEMID"};
  return("item") if ($tmp eq $ticket);
 

  $sql  = "select oxaccreqid from ox_acc_req where ";
  $sql .= " oxaccreqid = $ticket ";
  $sth  = $dbh->prepare($sql);
  $sth->execute;
  $ref = $sth->fetchrow_hashref;
  $sth->finish;
  $tmp = $$ref{"OXACCREQID"};
  return("request") if ($tmp eq $ticket);

  $sql  = "select swhdcaseid from ox_access_request where ";
  $sql .= " swhdcaseid = $ticket ";
  $sth  = $dbh->prepare($sql);
  $sth->execute;
  $ref = $sth->fetchrow_hashref;
  $sth->finish;
  $tmp = $$ref{"SWHDCASEID"};
  return("oldrequest") if ($tmp eq $ticket);
  return("missing");
}




#
# What:  This procedure will get ticket info, should error check before
#        entering this procedure to makes sure ticket type is of issue,
#        request, item, oldrequest
# Input: Ticket Number, Ticket Type(can get type from getticktype()
# Output:A reference to a Hash Containing Type, area, detail, entire
#        base record of each ticket, and person with phone no. who opened
#        ticket
# Requires: a database handle to be opened, and stored in $dbh
# Form:  %info =
#  gettickinfo( ticket => $ticketnum, type => $tickettype, dbh => $dbh);
#
 
sub gettickinfo {
  my(%args) = @_;
  my($ticket) = $args{"ticket"};
  my($type)   = $args{"type"};
  my($dbh)    = $args{"dbh"};
  my($sql);
  my($ref);


# Must enumerate each field as sw.* causes buffer overrun due to large
# Added on fields in sw_hd_case be careful that logic handles this limit.

  if ($type eq "issue") {
    $sql  = "select sw.swstatus, sw.swspecialtytype, sw.swspecialtyid, ";
    $sql .= "sw.swreportedby, sw.swresbyfirstcall, sw.timestamp, ";
    $sql .= "sw.swproblemarea, sw.swpriority, sw.swhdcaseid, sw.swextension, ";
    $sql .= "sw.swglobalimpact, sw.swmasterver, sw.swcreatedby, ";
    $sql .= "sw.swdatecreated, sw.oxy2kissue, sw.oxterminaltype, ";
    $sql .= "sw.oxreporttype, sw.oxterminaltype, sw.oxreceived, ";
    $sql .= "sw.oxnoticeflag, sw.oxproblemowner, sw.oxsladate, ";
    $sql .= "sw.oxtolocation, sw.swassignedto, sw.oxhotflag, sw.swdateresolved, ";
    $sql .= "sw.oxchangecontrolno, sw.oxassignedto, sw.oxfromlocation, ";
    $sql .= "sw.swresolutionid, sw.swresolvedby, sw.swprodreleaseid, ";
    $sql .= "sw.swdepartmentid, emp.swofficephoneext, site.swofficecode ";
    $sql .= " ,swp.swproblemdetail, emp.swfirstname, emp.swlastname, ";
    $sql .= "  emp.swlogin, sw.swnote ";
    $sql .= "from sw_employee_vw emp, sw_site site, ";
    $sql .= "sw_hd_case sw, sw_specialty swp ";
    $sql .= " where sw.swhdcaseid = $ticket ";
    $sql .= " and sw.swreportedby = emp.swpersonid ";
    $sql .= " and sw.swspecialtyid = swp.swspecialtyid ";
  }
  elsif ($type eq "item") {
    $sql  = "select sw.*, emp.swfirstname, emp.swlastname, ";
    $sql .= "   emp.swofficephoneext, site.swofficecode ";
    $sql .= " ,swp.swname, emp.swlogin  ";
    $sql .= " from sw_employee_vw emp, sw_site site, ";
    $sql .= "ox_acc_item sw, sw_prod_release swp ";
    $sql .= " where sw.oxaccitemid = $ticket ";
    $sql .= "  and sw.swprodreleaseid = swp.swprodreleaseid ";
    $sql .= " and sw.oxemployeeid = emp.swpersonid "
  }
  elsif ($type eq "request") {
    $sql  = "select sw.*, emp.swfirstname, emp.swlastname, ";
    $sql .= "   emp.swofficephoneext, site.swofficecode, emp.swlogin ";
    $sql .= " from sw_employee_vw emp, sw_site site, ";
    $sql .= " ox_acc_req  sw ";
    $sql .= " where sw.oxaccreqid = $ticket";
    $sql .= " and sw.swreportedby = emp.swpersonid ";
  }
  elsif ($type eq "oldrequest") {
    $sql  = "select sw.*, emp.swfirstname, emp.swlastname, ";
    $sql .= "   emp.swofficephoneext, site.swofficecode ";
    $sql .= " ,swp.swproblemdetail, emp.swlogin ";
    $sql .= " from sw_employee_vw emp, sw_site site, ";
    $sql .= " ox_access_request sw, sw_specialty swp ";
    $sql .= " where swhdcaseid = $ticket ";
    $sql .= " and sw.swreportedby = emp.swpersonid ";
    $sql .= " and sw.swspecialtyid = swp.swspecialtyid ";
   
  }
  else { return();} # Not a valid ticket type, don't wanna SQL
 $sql .= " and emp.swsiteid = site.swsiteid ";

  $sth  = $dbh->prepare($sql);
  $sth->execute;
  $ref = $sth->fetchrow_hashref;
  $sth->finish;
  return(%$ref);
}


#
# What:  A predictable way on how DBI script fails
# Input: Error message encountered by script as Argument
# Output:Call to Notify sub procedure.
# Requires: sub notify
#

sub diewithhonor {
  my(%args)    = @_;
  my($message) = $args{"message"};
  my($tag)     = $args{"tag"};

  notify(tag => $tag, short =>$message, long => "" );
  exit;
}


#
# What:  How DBI, VANDAL, will notify a script failure, using ONE
# Input: Tag, error message
# Output:rsh to ONE for event notification
# Requires: access to execute /bin/rsh
# Form :  notify[fail]( tag => $tag, short => $short, long => $long);
# notifyfail will exit sending an error condition
#

sub notify {
  my(%args)   = @_;
  my($tag)    = $args{"tag"};
  my($short)  = $args{"short"};
  my($long)   = $args{"long"};
  my($rsh) = "/bin/rsh one -l one $tag";

  open(RSH,"|$rsh");
  printf RSH "%s\n",$short;
  printf RSH "%s\n",$long if ($long ne "");
  close(RSH);
}

sub notifyfail {
  my(%args)   = @_;
  my($tag)    = $args{"tag"};
  my($short)  = $args{"short"};
  my($long)   = $args{"long"};
  my($rsh) = "/bin/rsh one -l one $tag";

  open(RSH,"|$rsh");
  printf RSH "%s\n",$short;
  printf RSH "%s\n",$long if ($long ne "");
  close(RSH);
  exit(1);
}

#
# What:  Gets ORACLE session to return all dates in Julian Format
# Input: None
# Output:None
# Requires: a database handle to be opened, and stored in $dbh
# Form gettimeintojulian($dbh)
#
 
sub gettimeintojulian {

my($sql);
my($dbh) = $_[0];
my($sth);
my($rc);

$sql  = 'alter session set nls_date_format = "J.SSSSS"';
$sth  = $dbh->prepare($sql);
$rc   = $sth->execute;
$sth->finish;
}

sub gettimeintonorm {

my($sql);
my($dbh) = $_[0];
my($sth);
my($rc);

$sql  = 'alter session set nls_date_format = "DD-MMM-YY HH24:MI:SS"';
$sth  = $dbh->prepare($sql);
$rc   = $sth->execute;
$sth->finish;
}

#
# What:  Returns julian date equivalent from UNIXTIME (secs after epoch)
#        Input
# Input: UNIXTIME, number of hours different from GMT(optional)
# Output:Juliandate.number_of_seconds_past_midnight
# Requires: a computer that can do math
# Form : $juliantime = unixtimetojulian(unixtime => $unixtime, hours => $hours)
#

sub unixtimetojulian {
my(%args)         = @_;
my($unixtime)     = $args{"unixtime"};
my($hours)        = $args{"hours"};
my($secsperday)   = 86400;
my($hoursdiffgmt) = $hours || 5;
my($secsdiffgmt)  = $hoursdiffgmt * 3600;
my($juliandays);
my($juliansecs);
my($tot);


$juliandays = 2440588 + ($unixtime / $secsperday) ;
$juliansecs = ($unixtime % 86400);
$juliansecs = $juliansecs - $secsdiffgmt;
if ( $juliansecs < "0" ) {
  $juliandays--;
  $juliansecs =  86400 + $juliansecs ;
}
$tot = sprintf "%7d.%05d",$juliandays,$juliansecs;
return($tot);
}
#
#What:  Gets a database handle call by: $dbh = getdbh();
#Returns: Database handle as string ($dbh)
#Requires: Initialize must be run
#

sub getdbh {
my(%cfg) = %VANDAL::cfg;
print Dumper(%cfg);
my($dbh) = DBI->connect($cfg{"dbname"},
                    $cfg{"user"},
                    $cfg{"password"},
                    $cfg{"dbd"},{AutoCommit => 0});
$message = "Error connecting to database $cfg{'dbname'}, $DBI::errstr\n";
$tag     = "vantive:VANDAL:ERROR:dbconnect";
for $key (keys %ENV){
    $message .= "Env.var:$key  val:$env{$key} ";
}
diewithhonor(tag => $tag, message => $message) if (!$dbh);
return($dbh);
}
 
sub getaudittrail {

  my(%args) = @_;
  my($ticket) = $args{"ticket"};
  my($dbh)    = $args{"dbh"};
  my($sql);
  my($sth);
  my($ref);
  my($count);
  my(%back);
  my($key);
  my($id);

  $sql  = "select swcolumnname, swtablename, swdatechanged, swnewvalue, ";
  $sql .= " sworiginalvalue, swauditid from sw_audit_trail where ";
  $sql .= " swobjectid = $ticket ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  while ($ref = $sth->fetchrow_hashref) {
    $id = $$ref{"SWAUDITID"};
    for $key (keys %$ref) {
      $back{$id}{$key} = $$ref{$key};
    }
  }
  $sth->finish;
  return(%back);  
}
sub getnotes{

  my(%args) = @_;
  my($ticket) = $args{"ticket"};
  my($dbh)    = $args{"dbh"};
  my($sql);
  my($sth);
  my($ref);
  my($count);
  my(%back);
  my($key);
  my($id);

  $sql .= " select swsubject, swcreatedby, swdatecreated, swnote, swworklogid ";
  $sql .= " from sw_work_log where ";
  $sql .= " swobjectid = $ticket ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  while ($ref = $sth->fetchrow_hashref) {
    $id = $$ref{"SWWORKLOGID"};
    for $key (keys %$ref) {
      $back{$id}{$key} = $$ref{$key};
    }
  }
  $sth->finish;
  return(%back);  
}

sub getitems {

  my(%args) = @_;
  my($ticket) = $args{"ticket"};
  my($dbh)    = $args{"dbh"};
  my($sql);
  my($sth);
  my($ref);
  my(%back);
  my($key);
  my($id);

  $sql  = "select sw.*, emp.swfirstname, emp.swlastname, ";
  $sql .= "   emp.swofficephoneext, site.swofficecode ";
  $sql .= " ,swp.swname, emp.swlogin  ";
  $sql .= " from sw_employee_vw emp, sw_site site, ";
  $sql .= "ox_acc_item sw, sw_prod_release swp ";
  $sql .= " where sw.oxaccreqid = $ticket ";
  $sql .= "  and sw.swprodreleaseid = swp.swprodreleaseid ";
  $sql .= " and sw.oxemployeeid = emp.swpersonid ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  while ($ref = $sth->fetchrow_hashref) {
    $id = $$ref{"OXACCITEMID"};
    for $key (keys %$ref) {
      $back{$id}{$key} = $$ref{$key};
    }
  }
  $sth->finish;
  return(%back);
}

sub getinboxlist {

  my(%args) = @_;
  my($dbh)    = $args{"dbh"};
  my($sql);
  my($sth);
  my($ref);
  my(%back);
  my($key);
  my($id);

  $sql  = "select swinboxname ";
  $sql .= " from  sw_inbox ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  while ($ref = $sth->fetchrow_hashref) {
   next if ($$ref{"SWVOID"} == "1");
    $id = $$ref{"SWINBOXNAME"};
    $id =~ s/ /_/g;
    $back{$id} = $$ref{"SWINBOXNAME"};
  }
  $sth->finish;
  return(%back);
}

sub getinboxmembers {

  my(%args)   = @_;
  my($dbh)    = $args{"dbh"};
  my($inbox)  = $args{"inbox"};
  my($sql);
  my($sth);
  my($ref);
  my($back)  = "";
  my($key);
  my($id);

  $sql  = "select swuser ";
  $sql .= " from  sw_user ";
  $sql .= " where swdefaultinbox = '$inbox' ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  while ($ref = $sth->fetchrow_hashref) {
    $key = $$ref{'SWUSER'};
    $back .= "$key:";
  }
  $sth->finish;
  chop($back);
  return($back);
}

sub getinboxitems {

  my(%args)   = @_;
  my($dbh)    = $args{"dbh"};
  my($sql);
  my($inboxes);
  my($sth);
  my($ref);
  my(%back);
  my($key);
  my($id);

  $sql  = "select sw.swdatecreated, sp.swproblemdetail, emp.swlogin, ";
  $sql .= " sw.swspecialtytype, sw.swproblemarea, sw.oxassignedto, ";
  $sql .= " sw.swhdcaseid, sw.swstatus ";
  $sql .= " from  sw_hd_case sw, sw_employee_vw emp, sw_specialty sp ";
  $sql .= " where sw.swstatus != 'Closed' AND ";
  $sql .= " sw.swspecialtyid = sp.swspecialtyid AND ";
  $sql .= " sw.swreportedby = emp.swpersonid ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  while ($ref = $sth->fetchrow_hashref) {
    $key = $$ref{'SWHDCASEID'};
    $back{$key}{'datecreated'} = $$ref{'SWDATECREATED'};
    $back{$key}{'type'} = $$ref{'SWSPECIALTYTYPE'};
    $back{$key}{'area'} = $$ref{'SWPROBLEMAREA'};
    $back{$key}{'detail'} = $$ref{'SWPROBLEMDETAIL'};
    $back{$key}{'assignedto'} = $$ref{'OXASSIGNEDTO'};
    $back{$key}{'ticktype'} = "Problem Report";
    $back{$key}{'status'} = $$ref{'SWSTATUS'};
    $back{$key}{'probowner'} = $$ref{'SWLOGIN'};
  }
  $sth->finish;
  $sql  = "select ox.oxaccreqid, ox.swdatecreated, emp.swlogin, ";
  $sql .= " ox.oxrequesttype, ox.swstatus from  ox_acc_req ox, sw_employee_vw emp";
  $sql .= " where (ox.swstatus not like 'Close%' AND ox.swstatus != 'Cancelled' )";
  $sql .= " AND emp.swpersonid = ox.swassignedto ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  while ($ref = $sth->fetchrow_hashref) {
    $key = $$ref{'OXACCREQID'};
    $back{$key}{'datecreated'} = $$ref{'SWDATECREATED'};
    $back{$key}{'type'} = $$ref{'OXREQUESTTYPE'};
    $back{$key}{'assignedto'} = $$ref{'SWLOGIN'};
    $back{$key}{'ticktype'} = "Request";
    $back{$key}{'status'} = $$ref{'SWSTATUS'};
  }
  $sth->finish;
  $sql  = "select ox.*, emp.swlogin, sp.swname";
  $sql .= " from  ox_acc_item ox, sw_employee_vw emp, sw_prod_release sp";
  $sql .= " where (ox.swstatus not like 'Closed%')  ";
  $sql .= " AND emp.swpersonid = ox.oxemployeeid ";
  $sql .= " AND ox.swprodreleaseid = sp.swprodreleaseid ";
  $sth  = $dbh->prepare($sql)|| die $dbh->errstr;
  $sth->execute;
  while ($ref = $sth->fetchrow_hashref) {
    $key = $$ref{'OXACCITEMID'};
    $back{$key}{'datecreated'} = $$ref{'SWDATECREATED'};
    $back{$key}{'type'} = $$ref{'OXITEMTYPE'};
    $back{$key}{'area'} = $$ref{'SWNAME'};
    $back{$key}{'detail'} = $$ref{'OXACTION'};
    $back{$key}{'assignedto'} = $$ref{'OXASSIGNEDTO'};
    $back{$key}{'ticktype'} = "Request Item";
    $back{$key}{'status'} = $$ref{'SWSTATUS'};
    $back{$key}{'sla'} = $$ref{'OXSLADATE'};
    $back{$key}{'probowner'} = $$ref{'SWLOGIN'};
  }
  $sth->finish;
  return(%back);
}
1;

***end VANDAL.pm***

THANKS!
I tried another test script just to see if I could make a connection to the database. Teh script looks like this:

*** start code ***
#!/usr/local/bin/perl
use DBI;
$dbname    = 'vadv';
$user      = 'swb';
$password  = 'qtip';
$dbd       = 'Oracle';

$dbh = DBI->connect($dbname, $user, $password, $dbd); if (!$dbh) {
      print "Error connecting to database $dbname, $DBI::errstr \n"; } $cur = "select distinct oxproblemowner from ox_inbox_info" ;

print ("$cur \n");
$sth = $dbh->prepare( $cur );
$rc = $sth->execute;
print "Query will return $sth->{NUM_OF_FIELDS} field(s) .\n\n"; print "Field names: @{ $sth->{NAME} } \n" ;

while ( @row = $sth->fetchrow_array ) {
  print "@row\n" ;
}
$dbh->disconnect;
*** end code ***

The error I get is :

>perl testdbi.pl
DBI->connect using 'old-style' syntax is deprecated and will be an error in future versions at testdbi.pl line 8
install_driver(Oracle) failed: Can't load '/opt/tools/perl5/lib/site_perl/5.8.3/aix/auto/DBD/Oracle/Oracle.so' for module DBD::Oracle:  0509-130 Symbol resolution failed for /opt/tools/perl5/lib/site_perl/5.8.3/aix/auto/DBD/Oracle/Oracle.so because:
        0509-136   Symbol ociepgoe (number 94) is not exported from
                   dependent module /oracle/product/dev6i/lib/libclntsh.a(shr.o).
        0509-136   Symbol OCILobWriteAppend (number 98) is not exported from
                   dependent module /oracle/product/dev6i/lib/libclntsh.a(shr.o).
        0509-192 Examine .loader section symbols with the
                 'dump -Tv' command. at /opt/tools/perl5/lib/5.8.3/aix/DynaLoader.pm line 229.
 at (eval 1) line 3
Compilation failed in require at (eval 1) line 3.
Perhaps a required shared library or dll isn't installed where expected
 at testdbi.pl line 8

Does this help any diagnosis? Thanks
Ooh.. now that's different. How did you install DBI and DBD::Oracle on the new machine?
It is a development machine and those modules were already installed beforehand. Do you think it is likely a version incompatibilty?
ASKER CERTIFIED SOLUTION
Avatar of BobMc
BobMc

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial