1package DBD::SQLRelay; 2 3use strict; 4use vars qw($err $errstr $sqlstate $drh); 5use SQLRelay::Connection; 6use SQLRelay::Cursor; 7use Data::Dumper; 8 9use DBI qw(:sql_types); 10 11$err=0; # holds error code for DBI::err 12$errstr=''; # holds error string for DBI::err 13$sqlstate=''; # holds SQL state for DBI::state 14 15$drh=undef; # holds driver handle 16 17sub driver { 18 19 # return the driver handle if it's already 20 # defined to prevent multiple driver instances 21 return $drh if $drh; 22 23 # get parameters 24 my ($class,$attr)=@_; 25 26 # append ::dr to the class name 27 $class .='::dr'; 28 29 # create the driver handle 30 $drh=DBI::_new_drh($class, { 31 'Name' => 'SQLRelay', 32 'Version' => 0, 33 'Err' => \$DBD::SQLRelay::err, 34 'Errstr' => \$DBD::SQLRelay::errstr, 35 'State' => \$DBD::SQLRelay::state, 36 'Attribution' => 'DBD::SQLRelay by Dmitry Ovsyanko', 37 }); 38 return $drh 39} 40 41 42# driver class 43package DBD::SQLRelay::dr; 44 45$DBD::SQLRelay::dr::imp_data_size=0; 46 47sub connect { 48 49 # get parameters 50 my ($drh, $dbname, $user, $password, $attr)=@_; 51 52 local $ENV{DBI_AUTOPROXY}='' if $ENV{DBI_AUTOPROXY} && $ENV{DBI_AUTOPROXY} =~ /^dbi:SQLRelay/i; 53 54 # create a blank database handle 55 my $dbh=DBI::_new_dbh($drh, { 56 'Name' => $dbname, 57 'USER' => $user, 58 'CURRENT_USER' => $user, 59 }); 60 61 # set some defaults 62 my %dsn; 63 $dsn{'host'}='localhost'; 64 $dsn{'port'}=9000; 65 $dsn{'socket'}=''; 66 $dsn{'krb'}=''; 67 $dsn{'krbservice'}=''; 68 $dsn{'krbmech'}=''; 69 $dsn{'krbflags'}=''; 70 $dsn{'tls'}=''; 71 $dsn{'tlsversion'}=''; 72 $dsn{'tlscert'}=''; 73 $dsn{'tlspassword'}=''; 74 $dsn{'tlsciphers'}=''; 75 $dsn{'tlsvalidate'}=''; 76 $dsn{'tlsca'}=''; 77 $dsn{'tlsdepth'}=0; 78 $dsn{'retrytime'}=0; 79 $dsn{'tries'}=1; 80 $dsn{'db'}=''; 81 $dsn{'debug'}=0; 82 $dsn{'lazyconnect'}=1; 83 $dsn{'bindvariabledelimiters'}="?:@\$"; 84 85 # split the dsn 86 my $var; 87 my $val; 88 foreach $var (split(/;/,$dbname)) { 89 if ($var=~/(.*?)=(.*)/) { 90 $var=$1; 91 $val=$2; 92 $dsn{$var}=$val; 93 $dbh->STORE($var,$val); 94 } 95 } 96 97 # create an Connection 98 my $connection=SQLRelay::Connection->new($dsn{'host'}, 99 $dsn{'port'}, 100 $dsn{'socket'}, 101 $user, 102 $password, 103 $dsn{'retrytime'}, 104 $dsn{'tries'}); 105 106 # turn on debugging if debugging was specified in the dsn 107 if (SQLRelay::Connection->isYes($dsn{'debug'})) { 108 $connection->debugOn(); 109 } elsif (!SQLRelay::Connection->isNo($dsn{'debug'})) { 110 $connection->setDebugFile($dsn{'debug'}); 111 $connection->debugOn(); 112 } 113 114 # turn on kerberos or tls 115 if (SQLRelay::Connection->isYes($dsn{'krb'})) { 116 $connection->enableKerberos($dsn{'krbservice'}, 117 $dsn{'krbmech'}, 118 $dsn{'krbflags'}); 119 } elsif (SQLRelay::Connection->isYes($dsn{'tls'})) { 120 $connection->enableTls($dsn{'tlsversion'}, 121 $dsn{'tlscert'}, 122 $dsn{'tlspassword'}, 123 $dsn{'tlsciphers'}, 124 $dsn{'tlsvalidate'}, 125 $dsn{'tlsca'}, 126 $dsn{'tlsdepth'}); 127 } 128 129 # if we're not doing lazy connects, then do something lightweight 130 # that will verify whether SQL Relay is available or not 131 if (SQLRelay::Connection->isNo($dsn{'lazyconnect'}) && 132 !$connection->identify()) { 133 $connection=undef; 134 $dbh=undef; 135 return $dbh; 136 } 137 138 if (length($dsn{'db'})) { 139 $connection->selectDatabase($dsn{'db'}); 140 } 141 142 # set bind variable delimiters 143 $connection->setBindVariableDelimiters($dsn{'bindvariabledelimiters'}); 144 145 # store some references in the database handle 146 $dbh->STORE('driver_database_handle',$drh); 147 $dbh->STORE('driver_connection',$connection); 148 149 # store a 1 for this database handle in the 'database handles' hash 150 # in the driver handle, indicating that this database handle exists 151 # and can be disconnected 152 $drh->{'dbhs'}->{$dbh}=1; 153 154 # mark this connection Active 155 $dbh->STORE('Active',1); 156 157 return $dbh; 158} 159 160sub disconnect_all { 161 162 # get parameters 163 my ($drh)=@_; 164 165 # run through the hash of database handles, disconnecting each 166 foreach (keys %{$drh->{'dbhs'}}) { 167 my $dbh=$drh->{'dbhs'}->{$_}; 168 next unless ref $dbh; 169 $dbh->disconnect(); 170 } 171 172 return 1; 173} 174 175 176# database class 177package DBD::SQLRelay::db; 178 179$DBD::SQLRelay::db::imp_data_size=0; 180 181sub _new_statement { 182 183 # get parameters 184 my ($dbh, $statement)=@_; 185 186 # create a blank statement handle 187 my $sth=DBI::_new_sth($dbh,{'Statement'=>$statement}); 188 189 # create an Cursor 190 my $cursor=SQLRelay::Cursor->new($dbh->FETCH('driver_connection')); 191 192 # store statement-specific attributes in the statement handle 193 $sth->STORE('driver_database_handle',$dbh); 194 $sth->STORE('driver_is_select',($statement=~/^\s*select/i)); 195 $sth->STORE('driver_cursor',$cursor); 196 197 # store attributes from the database handle 198 for (grep /^DBD::SQLRelay::/, keys %$dbh) { 199 $sth->STORE($_, $dbh->FETCH($_)); 200 } 201 202 # handle the row cache size 203 my $rowcachesize=$dbh->FETCH('RowCacheSize'); 204 if (!defined($rowcachesize)) { 205 $rowcachesize=$dbh->FETCH('DBD::SQLRelay::ResultSetBufferSize'); 206 } 207 if (!defined($rowcachesize) || $rowcachesize<0) { 208 $sth->STORE('DBD::SQLRelay::ResultSetBufferSize',0); 209 } elsif ($rowcachesize==0) { 210 $sth->STORE('DBD::SQLRelay::ResultSetBufferSize',100); 211 } else { 212 $sth->STORE('DBD::SQLRelay::ResultSetBufferSize',$rowcachesize); 213 } 214 215 # handle column case 216 my $columncase=$dbh->FETCH('DBD::SQLRelay::ColumnNameCase'); 217 if (!defined($columncase) || !$columncase) { 218 $sth->STORE('DBD::SQLRelay::ColumnNameCase',$columncase); 219 } 220 221 # handle column info 222 my $dontgetcolumninfo=$dbh->FETCH('DBD::SQLRelay::DontGetColumnInfo'); 223 if (!defined($dontgetcolumninfo) || !$dontgetcolumninfo) { 224 $sth->STORE('DBD::SQLRelay::DontGetColumnInfo', 225 $dontgetcolumninfo); 226 } 227 228 # handle nulls/empty-strings 229 my $getnullsasemptystrings= 230 $dbh->FETCH('DBD::SQLRelay::GetNullsAsEmptyStrings'); 231 if (!defined($getnullsasemptystrings) || !$getnullsasemptystrings) { 232 $sth->STORE('DBD::SQLRelay::GetNullsAsEmptyStrings',0); 233 } 234 235 # clear any binds still hanging around from 236 # the last time this cursor was used 237 $cursor->clearBinds(); 238 239 return $sth; 240} 241 242sub prepare { 243 244 # get parameters 245 my ($dbh, $statement, @attribs)=@_; 246 247 # create a statement 248 my $sth=_new_statement($dbh,$statement); 249 250 # get the cursor from the statement 251 my $cursor=$sth->FETCH('driver_cursor'); 252 253 # prepare the query 254 $cursor->prepareQuery($statement); 255 256 # count bind vars 257 $sth->STORE('NUM_OF_PARAMS',$cursor->countBindVariables()); 258 return $sth; 259} 260 261sub disconnect { 262 263 # get parameters 264 my ($dbh)=@_; 265 266 # end the session 267 $dbh->FETCH('driver_connection')->endSession(); 268 269 # remove references to this database handle from the driver handle 270 delete $dbh->FETCH('driver_database_handle')->{$dbh}; 271 delete $dbh->FETCH('driver_database_handle')->{'dbhs'}->{$dbh}; 272 273 # mark this connection not Active 274 $dbh->STORE('Active',0); 275} 276 277sub begin_work { 278 279 # get parameters 280 my ($dbh)=@_; 281 282 # handle autocommit 283 if ($dbh->FETCH('driver_AutoCommit')) { 284 if ($dbh->FETCH('Warn')) { 285 warn('Commit ineffective while AutoCommit is on'); 286 } 287 } 288 289 # execute a begin 290 return $dbh->FETCH('driver_connection')->begin(); 291} 292 293sub commit { 294 295 # get parameters 296 my ($dbh)=@_; 297 298 # handle autocommit 299 if ($dbh->FETCH('driver_AutoCommit')) { 300 if ($dbh->FETCH('Warn')) { 301 warn('Commit ineffective while AutoCommit is on'); 302 } 303 } 304 305 # execute a commit 306 return $dbh->FETCH('driver_connection')->commit(); 307} 308 309sub rollback { 310 311 # get parameters 312 my ($dbh)=@_; 313 314 # handle autocommit 315 if ($dbh->FETCH('driver_AutoCommit')) { 316 if ($dbh->FETCH('Warn')) { 317 warn('Commit ineffective while AutoCommit is on'); 318 } 319 } 320 321 # execute a rollback 322 return $dbh->FETCH('driver_connection')->rollback(); 323} 324 325sub get_info { 326 327 my ($dbh,$index)=@_; 328 329 # see GetInfoType for where these numbers come from 330 331 if ($index==2) { 332 # data source name 333 return $dbh->FETCH('driver_connection')->getCurrentDatabase(); 334 } elsif ($index==17) { 335 # dbms name 336 if ($dbh->FETCH('driver_dbmsname') eq '') { 337 $dbh->STORE('driver_dbmsname', 338 $dbh->FETCH('driver_connection')->identify()); 339 } 340 return $dbh->FETCH('driver_dbmsname'); 341 } elsif ($index==18) { 342 # dbms version 343 return $dbh->FETCH('driver_connection')->dbVersion(); 344 } elsif ($index==13) { 345 # server name 346 return $dbh->FETCH('driver_connection')->dbHostName(); 347 } elsif ($index==47) { 348 # user name 349 return $dbh->FETCH('USER'); 350 } elsif ($index==29) { 351 # identifier quote character 352 my $identity=$dbh->get_info(17); 353 if ($identity eq 'mysql') { 354 return '`'; 355 } 356 return '"'; 357 } elsif ($index==41) { 358 # catalog name separator 359 my $identity=$dbh->get_info(17); 360 if ($identity =~ m/oracle/) { 361 return '@'; 362 } 363 return '.'; 364 } elsif ($index==114) { 365 # catalog location 366 my $identity=$dbh->get_info(17); 367 if ($identity =~ m/oracle/) { 368 return 2; 369 } 370 return 1; 371 } 372 373 return undef; 374} 375 376sub ping { 377 378 # get parameters 379 my ($dbh,$attr)=@_; 380 381 # execute a ping 382 return $dbh->FETCH('driver_connection')->ping(); 383} 384 385sub last_insert_id { 386 387 # get parameters 388 my ($dbh)=@_; 389 390 # get the last insert id 391 return $dbh->FETCH('driver_connection')->getLastInsertId(); 392} 393 394sub DESTROY { 395 396 # get parameters 397 my ($dbh)=@_; 398 399 # mark this statement not Active 400 # (in case the app didn't call disconnect) 401 $dbh->STORE('Active',0); 402 403 # call DESTROY from the parent class 404 $dbh->SUPER::DESTROY(); 405} 406 407sub STORE { 408 409 # get parameters 410 my ($dbh,$attr,$val)=@_; 411 412 # handle special cases... 413 if ($attr eq 'AutoCommit') { 414 $dbh->{'driver_AutoCommit'}=$val; 415 my $connection=$dbh->FETCH('driver_connection'); 416 if ($val) { 417 $connection->autoCommitOn(); 418 } else { 419 $connection->autoCommitOff(); 420 } 421 return 1; 422 } elsif ($attr eq 'RowCacheSize') { 423 $dbh->{'driver_RowCacheSize'}=$val; 424 return 1; 425 } elsif ($attr eq 'DBD::SQLRelay::Debug') { 426 my $connection=$dbh->FETCH('driver_connection'); 427 if ($val==1) { 428 $connection->debugOn(); 429 } elsif ($val==2) { 430 $connection->debugOff(); 431 } else { 432 $connection->setDebugFile($val); 433 } 434 return 1; 435 } 436 437 # handle other cases 438 if ($attr =~ /^(?:driver_|DBD::SQLRelay::)/) { 439 $dbh->{$attr}=$val; 440 return 1; 441 } 442 443 # if the attribute didn't start with 'driver_' 444 # then pass it up to the parent class 445 return $dbh->SUPER::STORE($attr,$val); 446} 447 448sub FETCH { 449 450 # get parameters 451 my ($dbh,$attr)=@_; 452 453 # handle special cases... 454 if ($attr eq 'AutoCommit') { 455 return $dbh->{'driver_AutoCommit'}; 456 } 457 elsif ($attr eq 'RowCacheSize') { 458 return $dbh->{'driver_RowCacheSize'}; 459 } 460 461 # handle other cases 462 if ($attr =~ /^(?:driver_|DBD::SQLRelay::)/) { 463 return $dbh->{$attr}; 464 } 465 466 # pass it up to the parent class 467 $dbh->SUPER::FETCH($attr); 468} 469 470# statement class 471package DBD::SQLRelay::st; 472 473$DBD::SQLRelay::st::imp_data_size=0; 474 475sub bind_param { 476 477 # get parameters 478 my ($sth,$param,$val,$attr)=@_; 479 480 # determine type, length, precision, scale... 481 my $type; 482 my $length; 483 my $precision; 484 my $scale; 485 if ($attr) { 486 if (!ref($attr)) { 487 $type=$attr; 488 } elsif (ref($attr) eq 'HASH') { 489 $type=$attr->{type} || $attr->{Type} || $attr->{TYPE}; 490 $length=$attr->{length}; 491 $precision=$attr->{precision}; 492 $scale=$attr->{scale}; 493 } 494 } 495 if (!defined($length)) { 496 $length=length($val); 497 } 498 499 # remove any leading bind delimiters 500 my $p = $param; 501 $p=~s/^(:|@|\$)//; 502 503 # bind the parameter 504 my $cursor=$sth->FETCH('driver_cursor'); 505 if ($type eq 'DBD::SQLRelay::SQL_CLOB') { 506 $cursor->inputBindClob($p,$val,$length); 507 } elsif ($type eq 'DBD::SQLRelay::SQL_BLOB') { 508 $cursor->inputBindBlob($p,$val,$length); 509 } elsif (defined($precision) && defined($scale)) { 510 $cursor->inputBind($p,$val,$precision,$scale); 511 } else { 512 $cursor->inputBind($p,$val,$length); 513 } 514 515 # update ParamValues, ParamTypes 516 if (!$sth->FETCH('ParamValues')) { 517 $sth->STORE('ParamValues',{}); 518 } 519 $sth->FETCH('ParamValues')->{$param}=$val; 520 if (!defined($type)) { 521 $type='SQL_VARCHAR'; 522 } 523 if (!$sth->FETCH('ParamTypes')) { 524 $sth->STORE('ParamTypes',{}); 525 } 526 $sth->FETCH('ParamTypes')->{$param}=$type; 527 return 1; 528} 529 530sub bind_param_inout { 531 532 # get parameters 533 my ($sth,$param,$variable,$maxlen,$attr)=@_; 534 535 # determine type, length, precision, scale... 536 my $type; 537 if ($attr) { 538 if (!ref($attr)) { 539 $type=$attr; 540 } elsif (ref($attr) eq 'HASH') { 541 $type=$attr->{type} || $attr->{Type} || $attr->{TYPE}; 542 } 543 } 544 545 # remove any leading bind delimiters 546 my $p = $param; 547 $p=~s/^(:|@|\$)//; 548 549 # bind the parameter 550 my $cursor=$sth->FETCH('driver_cursor'); 551 if ($type eq 'DBD::SQLRelay::SQL_CLOB') { 552 $cursor->defineOutputBindClob($p); 553 } elsif ($type eq 'DBD::SQLRelay::SQL_BLOB') { 554 $cursor->defineOutputBindBlob($p); 555 } else { 556 $cursor->defineOutputBindString($p,$maxlen); 557 } 558 559 # store the parameter name in the list of inout parameters 560 my $param_inout_list=$sth->FETCH('driver_param_inout_list'); 561 $param_inout_list=$param_inout_list.' '.$param; 562 $sth->STORE('driver_param_inout_list',$param_inout_list); 563 564 # store the variable so data can be fetched into it later 565 $sth->STORE('driver_param_inout_'.$param,$variable); 566 567 # store the variable type 568 $sth->STORE('driver_param_inout_type_'.$param,$type); 569 570 return 1; 571} 572 573sub execute { 574 575 # get parameters 576 my ($sth,@bind_values)=@_; 577 my $dbh=$sth->{'Database'}; 578 579 # handle binds 580 my $cursor=$sth->FETCH('driver_cursor'); 581 582 # Clear and reset binds if they are being passed to execute() 583 if (scalar(@bind_values)) { 584 if (@bind_values!=$sth->FETCH('NUM_OF_PARAMS')) { 585 return $dbh->set_err(1,'Expected '. 586 $sth->FETCH('NUM_OF_PARAMS'). 587 ' bind values but was given '. 588 @bind_values); 589 } 590 591 my $index=1; 592 my $bind_value; 593 foreach $bind_value (@bind_values) { 594 $sth->bind_param($index,$bind_value) or return; 595 $index=$index+1; 596 } 597 } 598 599 # send the query 600 if (not $cursor->executeQuery()) { 601 $sth->STORE('driver_NUM_OF_ROWS',0); 602 if (!$sth->FETCH('NUM_OF_FIELDS')) { 603 $sth->STORE('NUM_OF_FIELDS',0); 604 } 605 $sth->STORE('driver_FETCHED_ROWS',0); 606 $sth->STORE('driver_RowsInCache',0); 607 return $dbh->DBI::set_err(1,$cursor->errorMessage()); 608 } 609 610 # get some result set info 611 my $colcount=$cursor->colCount(); 612 my $rowcount=$cursor->rowCount(); 613 my @colnames=map {$cursor->getColumnName($_)} (0..$colcount-1); 614 my @coltypes=map {$cursor->getColumnType($_)} (0..$colcount-1); 615 my @colprecision=map {$cursor->getColumnPrecision($_)} (0..$colcount-1); 616 my @colscale=map {$cursor->getColumnScale($_)} (0..$colcount-1); 617 my @colnullable=map {$cursor->getColumnIsNullable($_)} (0..$colcount-1); 618 if (!$sth->FETCH('NUM_OF_FIELDS')) { 619 $sth->STORE('NUM_OF_FIELDS',$colcount); 620 } 621 $sth->{NAME}=\@colnames; 622 $sth->{TYPE}=\@coltypes; 623 $sth->{PRECISION}=\@colprecision; 624 $sth->{SCALE}=\@colscale; 625 $sth->{NULLABLE}=\@colnullable; 626 $sth->STORE('driver_FETCHED_ROWS',0); 627 $sth->STORE('driver_RowsInCache',$cursor->rowCount()); 628 629 # get the list of output bind variables and turn it into an array 630 my $param_inout_list=$sth->FETCH('driver_param_inout_list'); 631 my @param_inout_array=split(' ',$param_inout_list || ''); 632 633 # loop through the array of parameters, for each, get the appropriate 634 # variable and store the output bind data in the variable 635 my $param; 636 foreach $param(@param_inout_array) { 637 my $variable=$sth->FETCH('driver_param_inout_'.$param); 638 my $type=$sth->FETCH('driver_param_inout_type_'.$param); 639 640 # remove any leading bind delimiters 641 my $p = $param; 642 $p=~s/^(:|@|\$)//; 643 if ($type eq 'DBD::SQLRelay::SQL_CLOB') { 644 $$variable=$cursor->getOutputBindClob($p); 645 } elsif ($type eq 'DBD::SQLRelay::SQL_BLOB') { 646 $$variable=$cursor->getOutputBindBlob($p); 647 } else { 648 $$variable=$cursor->getOutputBindString($p); 649 } 650 } 651 652 # mark this statement Active 653 $sth->STORE('Active',1); 654 655 my $rows=$sth->rows(); 656 if ($rows==0) { 657 return '0E0'; 658 } 659 return $sth->rows; 660} 661 662sub fetchrow_arrayref { 663 664 # get parameters 665 my ($sth)=@_; 666 667 # get the number of rows fetched so far 668 my $fetched_rows=$sth->FETCH('driver_FETCHED_ROWS'); 669 670 # get a row 671 my @row=$sth->FETCH('driver_cursor')->getRow($fetched_rows); 672 if (scalar(@row)==0) { 673 $sth->STORE('driver_RowsInCache',0); 674 $sth->finish(); 675 return undef; 676 } 677 678 # increment the fetched row count 679 $sth->STORE('driver_FETCHED_ROWS',$fetched_rows+1); 680 681 # update rows in cache 682 my $rowsincache=$sth->FETCH('driver_RowsInCache'); 683 if ($rowsincache==0) { 684 my $rowcachesize=$sth->FETCH('RowCacheSize'); 685 if ($rowcachesize>0) { 686 $rowsincache=$rowcachesize; 687 } 688 } 689 if ($rowsincache>0) { 690 $rowsincache--; 691 } 692 $sth->STORE('driver_RowsInCache',$rowsincache); 693 694 # chop blanks, if that's set 695 if ($sth->FETCH('ChopBlanks')) { 696 map { $_=~s/\s+$//; } @row; 697 } 698 699 return $sth->_set_fbav(\@row); 700} 701 702 703# required alias for fetchrow_arrayref 704*fetch=\&fetchrow_arrayref; 705 706sub rows { 707 708 # get parameters 709 my ($sth)=@_; 710 711 # return the number of affected rows 712 return $sth->FETCH('driver_cursor')->affectedRows(); 713} 714 715sub finish { 716 717 # get parameters 718 my ($sth)=@_; 719 720 # mark this statement not Active 721 # (older DBI's don't do this in their finish methods) 722 $sth->STORE('Active',0); 723 724 # call finish from the parent class 725 $sth->SUPER::finish(); 726} 727 728sub DESTROY { 729 730 # get parameters 731 my ($sth)=@_; 732 733 # mark this statement not Active 734 # (older DBI's don't do this in their DESTROY methods) 735 $sth->STORE('Active',0); 736 737 # call DESTROY from the parent class 738 $sth->SUPER::DESTROY(); 739} 740 741sub STORE { 742 743 # get parameters 744 my ($sth,$attr,$val)=@_; 745 746 # handle special cases... 747 if ($attr eq 'DBD::SQLRelay::ResultSetBufferSize') { 748 $sth->FETCH('driver_cursor')->setResultSetBufferSize($val); 749 return 1; 750 } elsif ($attr eq 'DBD::SQLRelay::ColumnNameCase') { 751 my $cursor=$sth->FETCH('driver_cursor'); 752 if ($val eq "upper") { 753 $cursor->upperCaseColumnNames(); 754 } elsif ($val eq "lower") { 755 $cursor->lowerCaseColumnNames(); 756 } else { 757 $cursor->mixedCaseColumnNames(); 758 } 759 } elsif ($attr eq 'DBD::SQLRelay::DontGetColumnInfo') { 760 my $cursor=$sth->FETCH('driver_cursor'); 761 if (SQLRelay::Connection->isYes($val)) { 762 $cursor->dontGetColumnInfo(); 763 } else { 764 $cursor->getColumnInfo(); 765 } 766 return 1; 767 } elsif ($attr eq 'DBD::SQLRelay::GetNullsAsEmptyStrings') { 768 my $cursor=$sth->FETCH('driver_cursor'); 769 if (SQLRelay::Connection->isYes($val)) { 770 $cursor->getNullsAsEmptyStrings(); 771 } else { 772 $cursor->getNullsAsUndefined(); 773 } 774 return 1; 775 } elsif ($attr eq 'RowsInCache') { 776 $sth->{'driver_RowsInCache'}=$val; 777 return 1; 778 } elsif ($attr eq 'ParamValues') { 779 $sth->{'driver_ParamValues'}=$val; 780 return 1; 781 } elsif ($attr eq 'ParamTypes') { 782 $sth->{'driver_ParamTypes'}=$val; 783 return 1; 784 } 785 786 # handle other cases 787 if ($attr =~ /^(?:driver_|DBD::SQLRelay::)/) { 788 $sth->{$attr}=$val; 789 return 1; 790 } 791 792 # pass it up to the parent class 793 return $sth->SUPER::STORE($attr,$val); 794} 795 796sub FETCH { 797 798 # get parameters 799 my ($sth,$attr)=@_; 800 801 # handle special cases... 802 if ($attr eq 'DBD::SQLRelay::ResultSetBufferSize') { 803 return $sth->FETCH('driver_cursor')->getResultSetBufferSize(); 804 } elsif ($attr eq 'RowsInCache') { 805 return $sth->{'driver_RowsInCache'}; 806 } elsif ($attr eq 'ParamValues') { 807 return $sth->{'driver_ParamValues'}; 808 } elsif ($attr eq 'ParamTypes') { 809 return $sth->{'driver_ParamTypes'}; 810 } 811 812 # handle other cases 813 if ($attr =~ /^(?:driver_|DBD::SQLRelay::)/) { 814 return $sth->{$attr}; 815 } 816 817 # if the attribute didn't start with 'driver_' 818 # then pass it up to the parent class 819 $sth->SUPER::FETCH($attr); 820} 821 8221; 823__END__ 824# 825 826=head1 NAME 827 828DBD::SQLRelay - perl DBI driver for SQL Relay 829 830=head1 SYNOPSIS 831 832use DBD::SQLRelay; 833 834my $dbh = DBI -> connect ('dbi:SQLRelay:$dsn', $login, $password); 835 836=head1 DESCRIPTION 837 838This module is a pure-Perl DBI binding to SQL Relay's native API. 839Connection string consists of following parts: 840 841=over 842 843=item B<host=...> default: I<localhost> --- hostname of SQL Relay server; 844 845=item B<port=...> default: I<9000> --- port number that SQL Relay server listens on; 846 847=item B<tries=...> default: I<1> --- how much times do we try to connect; 848 849=item B<retrytime=...> default: I<0> --- time (in seconds) between connect attempts; 850 851=item B<debug=...> default: I<0> --- set it to 1 if you want to get some debug messages in stdout; 852 853=back 854 855=head1 USAGE 856 857Once connected, DB handler works as usual (see L<DBI>). 858 859Don't ever try to share one SQLRelay connect by multiple scripts, for example, if you use 860Apache mod_perl. Every $dbh holds one of server connections, so call disconnect() directly 861at the end of every script and don't use Apache::DBI or SQLRelay will be deadlocked. 862 863=head2 Note for HTML::Mason Users 864 865If you use L<HTML::Mason>, your handler.pl sould look like this: 866 867 ... 868 869 { 870 package HTML::Mason::Commands; 871 use DBI; 872 use vars qw($db); 873 } 874 875 ... 876 877 sub handler { 878 879 $HTML::Mason::Commands::dbh = DBI -> connect (...); 880 881 my $status = $ah -> handle_request (...); 882 883 $HTML::Mason::Commands::dbh -> disconnect; 884 885 return $status; 886 887 } 888 889 890=head1 AUTHOR 891 892D. E. Ovsyanko, do@mobile.ru 893 894Contributions by: 895 896Erik Hollensbe <erik@hollensbe.org> 897 898Tony Fleisher <tfleisher@musiciansfriend.com> 899 900=head1 SEE ALSO 901 902http://www.firstworks.com 903 904=cut 905