Oracle Perl/DBI Example

Instructional Oracle Perl/DBI Example

Values Before Update

Counter[ 5240 ] Last_Update_Time[ 08/02/2004 11:10 ]

Values After Update

Counter[ 5241 ] Last_Update_Time[ 08/02/2004 11:11 ]


If your perl scripts generate html output, you can use

Princeton University Campus CGI Facility
development environment to test and debug your campuscgi perl/dbi/Instructional Oracle account scripts.

---

Source For Instructional Oracle Perl/DBI Example Script

#!/usr/psr.oit/solaris9/bin/perl use CGI; use DBI; use Oraperl; local(@Error_Lines); my($i); my $my_error = ""; # set flag not to buffer output $| = 1; undef(@Before_Counter); undef(@Before_Date); undef(@After_Counter); undef(@After_Date); $query = new CGI; $title="Instructional Oracle Perl/DBI Example"; $query = new CGI; $my_error_string=&dbiconnect; if($my_error_string ne "") { $title="Connect Error"; } else { #define my global array to hold return values undef(@value1_array); undef(@value2_array); $sql="select counter,to_char(last_update_time,'MM/DD/YYYY HH24:MI') from counter_table"; #expect two values returned from each row found #so passed the address of my sub "load_two_values" which handles the returned values $my_error=&dbiselect_and_ret_error($sql,&load_two_values); if($my_error ne "") { $title="Sql Error"; $my_error="Error[$my_error] from sql[$sql]"; } else { #copy returned values to my destination arrays @Before_Counter=@value1_array; @Before_Date=@value2_array; #now go update this table undef(@value1_array); undef(@value2_array); $sql="update counter_table set counter=counter+1,last_update_time=sysdate"; #expect no values returned but need to pass address of valid sub so reuse "load_two_values" $my_error=&dbiselect_and_ret_error($sql,&load_two_values); if($my_error ne "") { $title="Sql Error"; $my_error="Error[$my_error] from sql[$sql]"; } else { #now go commit the update if(&dbicommit) { #go retrieve the new values undef(@value1_array); undef(@value2_array); $sql="select counter,to_char(last_update_time,'MM/DD/YYYY HH24:MI') from counter_table"; $my_error=&dbiselect_and_ret_error($sql,&load_two_values); if($my_error ne "") { $title="Sql Error"; $my_error="Error[$my_error] from sql[$sql]"; } else { #copy returned values to my destination arrays @After_Counter=@value1_array; @After_Date=@value2_array; } } else { $title="Commit Error"; $my_error="Unable to commit update"; } } } } if($my_error eq "") { &dbidisconnect; print $query->header; print $query->start_html($title); print "

$title

n"; print "

Values Before Update

n"; for($i=0;$i<=$#Before_Counter;$i++) { print "Counter[ $Before_Counter[$i] ] Last_Update_Time[ $Before_Date[$i] ]n"; } print "

Values After Update

n"; for($i=0;$i<=$#After_Counter;$i++) { print "Counter[ $After_Counter[$i] ] Last_Update_Time[ $After_Date[$i] ]n"; } print $query->end_html; } else { push(@Error_Lines,$my_error); &Print_Error_Lines($query,$title,*Error_Lines); } sub dbiconnect { local($user,$password)=@_; my($Connect_Error); #PUT YOUR Instructional Oracle account/Oracle password HERE $user=""; $password=""; #use the oracle_home associated with psr (so this avoids having to install oracle client software on local machine) $ENV{'ORACLE_HOME'} = "/usr/psr.oit/solaris9/share/oracle-barebone"; my $twotask = 'storacle8.world'; # Load the Oracle driver. $driver = DBI->install_driver('Oracle'); if(!$driver) { $Connect_Error="Unable to load database driver ".$DBI::errstr; } else { # Tell Oracle to return longs in a big buffer. $Oraperl::ora_long = 8192; $database = $driver->connect( $twotask, $user, $password); if(!$database) { $Connect_Error=$driver->errstr; } else { $connected = 1; } } return $Connect_Error; } sub dbidisconnect { local($disconnect_done); $disconnect_done=$database->disconnect; return($disconnect_done); } sub dbicommit { local($commit_done); $commit_done=$database->commit; return($commit_done); } sub dbiselect_and_ret_error { my ($sql, $rowcmd) = @_; my $cursor; my($my_error); $my_error=""; $cursor = $database->prepare($sql) or return($database->errstr); $cursor->execute or return($cursor->errstr); my @row; while ( @row = $cursor->fetchrow ) { if ( defined($rowcmd) ) { &$rowcmd(@row); } } $cursor->finish; return($my_error); } sub Print_Error_Lines { local($query,$title,*Error_Lines) =@_; my($line); print $query->header; print $query->start_html(-title=>$title,-BGCOLOR=>'white'); print "

$title

n"; print " n"; if($#Error_Lines > -1) { print "

n"; foreach $line(@Error_Lines) { print "$linen"; } print "

n"; } else { print "error_line_cnt[$#Error_Lines]n"; } print "
n"; print "n"; print $query->end_html; } sub load_two_values { local($value1,$value2) = @_; # subroutine which expects two input values push(@value1_array,$value1); push(@value2_array,$value2); }

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/308563/viewspace-171977/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/308563/viewspace-171977/