Solved

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

Posted on 2004-10-28
340 Views
Last Modified: 2008-01-09
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


0
Question by:stevecamp
    13 Comments
     
    LVL 13

    Expert Comment

    by: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?
    0
     

    Author Comment

    by:stevecamp
    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.
    0
     
    LVL 13

    Expert Comment

    by:gripe
    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
    0
     
    LVL 13

    Expert Comment

    by:gripe
    while you're at it, you should also do:

    print Dumper(%VANDAL::cfg);

    Please respond with the results of both
    0
     

    Author Comment

    by:stevecamp
    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!
    0
     
    LVL 13

    Expert Comment

    by:gripe
    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?

    0
     

    Author Comment

    by:stevecamp
    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?
    0
     
    LVL 13

    Expert Comment

    by:gripe
    Yes, go ahead
    0
     

    Author Comment

    by:stevecamp
    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!
    0
     

    Author Comment

    by:stevecamp
    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
    0
     
    LVL 13

    Expert Comment

    by:gripe
    Ooh.. now that's different. How did you install DBI and DBD::Oracle on the new machine?
    0
     

    Author Comment

    by:stevecamp
    It is a development machine and those modules were already installed beforehand. Do you think it is likely a version incompatibilty?
    0
     
    LVL 7

    Accepted Solution

    by:
    You cant connect from Oracle 7.3 to Oracle 9.2 by any means - you will either get a 'Connections to Oracle7 are unsupported' or an 'end of file on communication error' bepending on which way around you try it.

    My perl isnt too hot, so I cant say whether or not all the above code will work with other Oracle versions, but youre flogging a dead horse with this setup.

    HTH
    Bob
    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Lean Six Sigma Project Manager Certification

    There are many schools of thought around successful project management, but few as highly regarded as the Six Sigma and Lean methods. With 37 hours of learning, this training will explain concrete processes for increasing efficiency and limiting wasted time and effort.

    Email validation in proper way is  very important validation required in any web pages. This code is self explainable except that Regular Expression which I used for pattern matching. I originally published as a thread on my website : http://www…
    A year or so back I was asked to have a play with MongoDB; within half an hour I had downloaded (http://www.mongodb.org/downloads),  installed and started the daemon, and had a console window open. After an hour or two of playing at the command …
    Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
    In this Experts Exchange video Micro Tutorial, I'm going to show how small business owners who use Google Apps can save money by setting up what is called a catch-all email address in their Gmail accounts. By using the catch-all feature, small busin…

    884 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    21 Experts available now in Live!

    Get 1:1 Help Now