File manager

File manager - Edit - /usr/local/share/perl5/HDB/MOD/oracle.pm

Back
############################################################################# ## Name: oracle.pm ## Purpose: HDB::MOD::oracle -> for DBD::Oracle ## Author: Graciliano M. P. ## Modified by: ## Created: 14/01/2003 ## RCS-ID: ## Copyright: (c) 2004 Graciliano M. P. ## Licence: This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself ############################################################################# package HDB::MOD::oracle ; use DBD::Oracle ; use strict qw(vars) ; no warnings ; our $VERSION = '1.0' ; our @ISA = qw(HDB::MOD) ; my (%OPENED_DBH) ; my %SQL = ( LIKE => 1 , REGEXP => 0 , LOCK_TABLE => 0 , SHOW => 0 , LIMIT => 0 , TYPES => [qw(NUMBER VARCHAR VARCHAR2 BOOLEAN)] , TYPES_MASK => { 'BOOLEAN' => 'NUMBER(1)' , } , ) ; ####### # NEW # ####### sub new { my $this = shift ; $this->{SQL} = \%SQL ; $this->{name} = 'HDB::Oracle' ; bless($this , __PACKAGE__) ; return( $this ) ; } ########### # CONNECT # ########### sub MOD_connect { my $this = shift ; my ( $pass ) = @_ ; my $db = $this->{db} ; my $host = $this->{host} ; $this->{dbh} = DBI->connect("DBI:Oracle:host=$host;sid=$db", $this->{user} , $pass , { RaiseError => 0 , PrintError => 1 , AutoCommit => 1 }) ; if (! $this->{dbh} ) { return $this->Error("Can't connect to db $db\@$host!") ;} return( $this->{dbh} ) ; } ############## # PRIMARYKEY # ############## sub PRIMARYKEY { return "PRIMARY KEY" ;} ################# # AUTOINCREMENT # ################# sub AUTOINCREMENT { return "NUMBER PRIMARY KEY" ;} ######### # LIMIT # ######### sub LIMIT { my $this = shift ; my ( $sz , $offset ) = @_ ; my $into_where = $offset ? "rownum >= $offset && $offset <= " . ($offset+$sz) : "rownum <= $sz" ; return( undef , $into_where) ; } ############# # TYPE_TEXT # ############# sub Type_TEXT { my $this = shift ; my ( $sz ) = @_ ; if ( $sz eq '0' ) { return $this->Type_INTEGER() ;} $sz = 65535 if $sz <= 0 ; my $ret = $sz <= 250 ? "VARCHAR($sz)" : ($sz <= 4000 ? "VARCHAR2($sz)" : "LONG") ; return $ret ; } ################ # TYPE_INTEGER # ################ sub Type_INTEGER { my $this = shift ; my ( $sz ) = @_ ; $sz =~ s/\D+//g ; $sz = 10 if $sz <= 0 ; $sz = 38 if $sz > 38 ; return "NUMBER($sz)" ; } ############## # TYPE_FLOAT # ############## sub Type_FLOAT { my $this = shift ; my ( $type , $args ) = @_ ; if ( $args !~ /\d/ ) { return "NUMBER(38)" ;} my $tp_arg ; if ( $args =~ /(\d+)\D+(\d+)/ ) { $tp_arg = "($1,$2)" ;} elsif ( $args =~ /(\d+)/ ) { $tp_arg = "($1)" ;} return "NUMBER$tp_arg" ; } ########## # TABLES # ########## sub tables { my $this = shift ; $this->{sql} = "SELECT TABLE_NAME FROM user_tables ORDER BY TABLE_NAME" ; eval{ $this->_undef_sth ; $this->{sth} = $this->dbh->prepare( $this->{sql} ) ; $this->{sth}->execute ; }; if ( $@ ) { $this->Error("SQL error: $this->{sql}") ;} my @tables = $this->Return('$') ; $this->_undef_sth ; return( sort @tables ) ; } ######### # NAMES # ######### sub names { my $this = shift ; my ( $table ) = @_ ; $table = HDB::CMDS::_format_table_name($table) ; if (! $table) { return $this->Error('Invalid table!') ;} elsif ( $this->{CACHE}{names}{$table} ) { return @{ $this->{CACHE}{names}{$table} } ;} $this->{sql} = "SELECT * FROM $table WHERE(rownum <= 1)" ; $this->_undef_sth ; eval{ $this->{sth} = $this->dbh->prepare( $this->{sql} ) ; $this->{sth}->execute ; }; return $this->Error("SQL error: $this->{sql}") if $@ ; my @names ; eval { @names = map { substr($_ , 0) } @{ $this->{sth}->{'NAME'} } }; $this->_undef_sth ; return () if !@names ; if ( $this->{cache} ) { $this->{CACHE}{names}{$table} = \@names ;} return @names ; } ############# # ON_CREATE # ############# sub ON_CREATE { my $this = shift ; my ( $table , $cols , $order ) = @_ ; $this->dbh->do(qq` create sequence HDBseq_$table start with 1 increment by 1 nomaxvalue `); $this->dbh->do(qq` create trigger HDBtrigger_$table before insert on $table for each row begin select HDBseq_$table.nextval into :new.ID from dual; end; `); } ########### # ON_DROP # ########### sub ON_DROP { my $this = shift ; my ( $table ) = @_ ; $this->dbh->do(qq` drop sequence HDBseq_$table `); } ############## # LOCK_TABLE # ############## sub lock_table { $_[0]->dbh->do("LOCK TABLE $_[1] IN EXCLUSIVE MODE") ;} ################ # UNLOCK_TABLE # ################ sub unlock_table { $_[0]->dbh->do("COMMIT") ;} ####### # END # ####### 1;

| ver. 1.4 | Github | . | PHP 8.3.31 | Generation time: 0 | proxy | phpinfo | Settings