FM / MOD

/usr/local/share/perl5/HDB/MOD

Name	Size	Mode	Actions
mysql.pm	3328	0444	edit dl rm
oracle.pm	5074	0444	edit dl rm
sqlite.pm	3806	0444	edit dl rm

Edit: /usr/local/share/perl5/HDB/MOD/oracle.pm (5074B)

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 #
#######

############################################################################# ## 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;