File Coverage

blib/lib/HDB/CMDS.pm

Criterion	Covered	Total	%
statement	9	531	1.6
branch	0	312	0.0
condition	0	44	0.0
subroutine	3	39	7.6
pod	0	28	0.0
total	12	954	1.2

#############################################################################
## Name:        CMDS.pm
## Purpose:     HDB::CMDS
## Author:      Graciliano M. P.
## Modified by:
## Created:     14/01/2003
## RCS-ID:
## Copyright:   (c) 2002 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::CMDS ;
use HDB::Parser ;

use strict qw(vars);
no warnings ;

our $VERSION = '1.0' ;

########
# VARS #
########

  my %args_select = (
  table  =>  [qw(table)] ,
  where  =>  [qw(where w)] ,
  limit  =>  [qw(limit limite)] ,
  sort   =>  [qw(sort order)] ,
  group  =>  [qw(group grop)] ,
  return =>  [qw(return ret r)] ,
  col    =>  [qw(col cols)] ,
  cache  => [[qw(cache)],1] ,
  );

  my %DEFAULT_COLS = (
  'address'      => 200 ,
  'age'          => 'INTEGER' ,
  'bairro'       => 30 ,
  'cep'          => 9 ,
  'cidade'       => 40 ,
  'city'         => 40 ,
  'country'      => 4 ,
  'data'         => 'int(9999999999)' ,
  'date'         => 'int(9999999999)' ,
  'descricao'    => 'TEXT' ,
  'email'        => 50 ,
  'endereco'     => 200 ,
  'estado'       => 3 ,
  'fax'          => 'INTEGER' ,
  'hits'         => 'INTEGER' ,
  'hora'         => 8 ,
  'id'           => 'INTEGER' ,
  'idade'        => 'INTEGER' ,
  'mail'         => 50 ,
  'message'      => 'TEXT' ,
  'msg'          => 'TEXT' ,
  'mensagem'     => 'TEXT' ,
  'name'         => 40 ,
  'nick'         => 16 ,
  'nome'         => 40 ,
  'pais'         => 4 ,
  'pass'         => 16 ,
  'password'     => 16 ,
  'phone'        => 'INTEGER' ,
  'preco'        => 15 ,
  'price'        => 15 ,
  'senha'        => 16 ,
  'sex'          => 1 ,
  'sexo'         => 1 ,
  'size'         => 5 ,
  'state'        => 3 ,
  'tamanho'      => 5 ,
  'tel'          => 'INTEGER' ,
  'telefone'     => 'INTEGER' ,
  'temperatura'  => 4 ,
  'time'         => 10 ,
  'titulo'       => 250 ,
  'title'        => 250 ,
  'uf'           => 3 ,
  'uid'          => 8 ,
  'url'          => 250 ,
  'username'     => 16 ,
  'user'         => 16 ,
  'zip'          => 9 ,
  );


  my @DEFAULT_TYPES = qw(* TEXT INT FLOAT BOOL) ;

  my %DEFAULT_MOD = (
  'MySQL'    => 'mysql' ,
  'SQLite'   => 'sqlite' ,
  'Oracle'   => 'Oracle' ,
  ) ;


###################
# PREDEFINED_COLS #
###################

sub predefined_columns { return( %DEFAULT_COLS ) ;}

#################
# DEFAULT_TYPES #
#################

sub default_types { return( @DEFAULT_TYPES ) ;}

###############
# DEFAULT_MOD #
###############

sub default_mod { return( %DEFAULT_MOD ) ;}

###########
# ALIASES #
###########

sub sel { &select ;}
sub cols { &names ;}
sub creat { &create ;}
sub create_table { &create ;}
sub predefined_cols { &predefined_columns ;}
sub sql { $_[0]->{sql} ;}

##########
# SELECT #
##########

sub select {
  my $this = shift ;
  my (undef , $where , @args) = @_ ;

  if ($_[0] =~ /^table$/i) { @args = @_ ; $where = undef ;}
  elsif ($#_ >= 2 && $#_ <= 3 && ( ref $_[2] || $_[2] =~ /^(?:(?:n|names?|c|cols?|columns?)\s*[,;]*\s*)?(?:\$?[\$\@\%]{1,2}|<[\$\@\%]>)$/i ) ) {
    if (ref $_[2]) { @args = HDB::CORE::parse_ref($_[2]) ;}
    elsif ($#_ == 2) { @args = ('return' , $_[2]) ;}
  }
  elsif ($#_ == 1 && $_[1] =~ /^(?:(?:n|names?|c|cols?|columns?)\s*[,;]*\s*)?(?:\$?[\$\@\%]{1,2}|<[\$\@\%]>)$/i ) {
    @args = ('return' , $_[1]) ;
    $where = undef ;
  }

  if ($#_ >= 2 && $where =~ /^(?:cache|col|cols|grop|group|limit|limite|order|r|ret|return|sort|table|w|where)$/si) {
    unshift (@args, $where) ;
    $where = undef ;
  }

  my %args ;
  &HDB::CORE::parse_args(\%args , \%args_select , @args) ;

  $args{table} = $_[0] if !defined $args{table} ;
  $args{where} = $where if !defined $args{where} ;

  $args{table} = _format_table_name($args{table}) ;

  if (! defined $args{return}) {
    if ( $_[-1] =~ /^(?:(?:n|names?|c|cols?|columns?)\s*[,;]*\s*)?(?:\$?[\$\@\%]{1,2}|<[\$\@\%]>)$/i ) { $args{return} = $_[-1] ;}
  }

  $this->{return} = $args{return} ;

  $this->{sql} = undef ;

  {
    my ($cols , $db_max) ;

    if ($args{col} =~ /^\s*([<>])\s*([\w\.]+)/) {
      $db_max = $1 ;
      $cols = $2 ;
    }
    else { $cols = $args{col} ;}

    if ($db_max) {
      if ($db_max eq '>') { $db_max = 'max' ;}
      elsif ($db_max eq '<') { $db_max = 'min' ;}
      if ($cols eq '') { $cols = "$db_max(ID) as ID" ;}
      else { $cols = "$db_max($cols) as $cols" ;}
    }
    elsif ($cols eq "") { $cols = '*' ;}
    else {
      $cols =~ s/^\s*,//s ;
      $cols =~ s/,\s*$//s ;
    }

    my $where = &HDB::Parser::Parse_Where($args{where},$this) ;

    my $group ;
    if ( $args{group} ) { $group = "GROUP BY $args{group}" ;}

    my $sort ;

    if ( $args{sort} ) {
      ($sort) = ( $args{sort} =~ /([\w\.]+)/gs ) ;
      $sort = "ORDER BY $sort" ;
      if ($args{sort} =~ /
    }
    #elsif (! defined $args{sort} ) { $sort = "ORDER BY ID" ;}

    my $limit ;
    if ($args{limit} ne '') {
      my ($sz,$init) = ( $args{limit} =~ /(\d+)(?:\D+(\d+)|)/ );
      my $into_where ;
      ($limit , $into_where) = $this->LIMIT($sz,$init) ;
      if ( $into_where ) { $where = "$where AND ($into_where)" ;}
    }

    $this->{sql} = "SELECT $cols FROM $args{table}" ;
    $this->{sql} .= " $where" if $where ne '' ;
    $this->{sql} .= " $group" if $group ne '' ;
    $this->{sql} .= " $sort" if $sort ne '' ;
    $this->{sql} .= " $limit" if $limit ne '' ;
  }

 $this->_undef_sth ;

 eval{
    $this->{sth} = $this->dbh->prepare( $this->{sql} ) ;
    $this->{sth}->{ShowErrorStatement} = 1 ;
    $this->{sth}->execute ;
    $this->{sth}->err ;
  };

  return $this->Error("SQL error: $this->{sql}") if $@ ;

  return $this->Return( $args{return} ) ;
}

##########
# INSERT #
##########

sub insert {
  my $this = shift ;

  my ($table , @up) = @_ ;

  $table = _format_table_name($table) ;

  if ($#_ == 1) { @up = HDB::CORE::parse_ref($_[1]) ;}

  return $this->Error('Invalid table!') if !$table ;
  return $this->Error('Nothing to insert!') if !@up ;

  my @names = $this->names($table) ;

  my @cols ;
  if (ref($_[1]) eq 'HASH') {
    my %up = @up ;
    @up = () ;

    foreach my $names_i ( @names ) {
      if    (defined $up{$names_i})     { push(@up , $up{$names_i}) ; push(@cols , $names_i) ;}
      elsif (defined $up{uc($names_i)}) { push(@up , $up{uc($names_i)}) ; push(@cols , $names_i) ;}
      elsif (defined $up{lc($names_i)}) { push(@up , $up{lc($names_i)}) ; push(@cols , $names_i) ;}
      elsif (defined $up{"\u\L$names_i\E"}) { push(@up , $up{"\u\L$names_i\E"}) ; push(@cols , $names_i) ;}
    }
  }
  else { @cols = @names ;}

  foreach my $up_i ( @up ) {
    if (ref($up_i) eq 'HASH') { $up_i = &HDB::Encode::Pack_HASH($up_i) ;}
    elsif (ref($up_i) eq 'ARRAY') { $up_i = &HDB::Encode::Pack_ARRAY($up_i) ;}
    &HDB::Parser::filter_null_bytes($up_i) ;
  }

  $this->_undef_sth ;

  {
    my @ins_pnt = ('?') x @up ;
    $this->{sql} = "INSERT INTO $table (". join(',',@cols) .") VALUES (". join(',',@ins_pnt) .")" ;
    eval { $this->{sth} = $this->dbh->prepare( $this->{sql} ) };
  }

  $this->{sth}->{ShowErrorStatement} = 1 ;

  eval {
    $this->lock_table($table) if $this->{SQL}{LOCK_TABLE} ;
    $this->{sth}->execute(@up) ;
    $this->unlock_table($table) if $this->{SQL}{LOCK_TABLE} ;
    $this->{sth}->err ;
  };

  $this->_undef_sth ;

  return $this->Error("SQL error: $this->{sql}\nERROR MSG:\n$@") if $@ ;

  $this->ON_INSERT(\@cols,\@up) if $this->can('ON_INSERT') ;

  return 1 ;
}

##########
# UPDATE #
##########

sub update {
  my $this = shift ;
  my ($table , $where , %up) = @_ ;

  $table = _format_table_name($table) ;

  if ($#_ == 2) { %up = HDB::CORE::parse_ref($_[2]) ;}

  if (! $table) { $this->Error('Invalid table!') ;}
  if (! %up) { $this->Error('Nothing to update!') ;}

  $where = &HDB::Parser::Parse_Where($where,$this) ;

  my ($set_cols,@up) ;

  my @names = $this->names($table) ;

  foreach my $names_i ( @names ) {
    if    (defined $up{$names_i})     { push(@up , $up{$names_i}) ; $set_cols .= "$names_i = ? , " ;}
    elsif (defined $up{uc($names_i)}) { push(@up , $up{uc($names_i)}) ; $set_cols .= "\U$names_i\E = ? , " ;}
    elsif (defined $up{lc($names_i)}) { push(@up , $up{lc($names_i)}) ; $set_cols .= "\L$names_i\E = ? , " ;}
    elsif (defined $up{"\u\L$names_i\E"}) { push(@up , $up{"\u\L$names_i\E"}) ; $set_cols .= "\u\L$names_i\E = ? , " ;}
  }

  return if !@up ;

  foreach my $up_i ( @up ) {
    if (ref($up_i) eq 'HASH') { $up_i = &HDB::Encode::Pack_HASH($up_i) ;}
    elsif (ref($up_i) eq 'ARRAY') { $up_i = &HDB::Encode::Pack_ARRAY($up_i) ;}
    &HDB::Parser::filter_null_bytes($up_i) ;
  }

  $set_cols =~ s/ , $// ;

  $this->{sql} = "UPDATE $table SET $set_cols $where" ;

  $this->_undef_sth ;
  eval { $this->{sth} = $this->dbh->prepare( $this->{sql} ) };

  eval {
    $this->lock_table($table) if $this->{SQL}{LOCK_TABLE} ;
    $this->{sth}->execute(@up) ;
    $this->unlock_table($table) if $this->{SQL}{LOCK_TABLE} ;
  };

  $this->_undef_sth ;

  return $this->Error("SQL error: $this->{sql}\nERROR MSG:\n$@") if $@ ;
  return 1 ;
}

##########
# DELETE #
##########

sub delete {
  my $this = shift ;
  my ($table , $where) = @_ ;

  $table = _format_table_name($table) ;

  if (! $table) { $this->Error('Invalid table!') ;}

  $where = &HDB::Parser::Parse_Where($where,$this) ;

  $this->{sql} = "DELETE FROM $table $where" ;

  eval {
    $this->lock_table($table) if $this->{SQL}{LOCK_TABLE} ;
    $this->dbh->do( $this->{sql} ) ;
    $this->unlock_table($table) if $this->{SQL}{LOCK_TABLE} ;
  };

  return $this->Error("SQL error: $this->{sql}\nERROR MSG:\n$@") if $@ ;
  return 1 ;
}

##########
# CREATE #
##########

sub create {
  my $this = shift ;
  my ($table , @cols) = @_ ;

  $table = _format_table_name($table) ;

  if ($#_ == 1) { @cols = HDB::CORE::parse_ref($_[1]) ;}

  if (! $table) { $this->Error('Invalid table!') ;}
  if (! @cols) { $this->Error('Cols not paste!') ;}

  my %tables = map { ("\L$_\E") => 1 } ($this->tables) ;
  if ( $tables{"\L$table\E"} ) { return ;}

  my (%cols,@order) ;

  for (my $i = 0 ; $i <= $#cols ; $i+=1) {
    my $name = $cols[$i] ;
    my $type ;

    if (ref($name)) {
      $name = HDB::CORE::parse_ref($name) ;
      $type = 'DEFAULT' ;
    }
    else { $type = $cols[$i+1] ; $i++ ;}

    my $is_primary ;
    if ($name =~ /^\s*\*/) { $name =~ s/^\s*\*\s*//gs ; $is_primary = 1 ;}

    $name =~ s/^\s+//gs ;
    $name =~ s/\s+$//gs ;

    $type = $this->get_type( $type , $name ) ;

    if ($is_primary) { $type = $this->Set_PRIMARYKEY($type) ;}

    push(@order , $name) ;
    $cols{$name} = $type ;
  }

  if (ref($_[1]) eq 'HASH') { @order = sort @order ;}

  if (! $cols{id}) {
    push(@order , 'id') ;
    $cols{id} = $this->AUTOINCREMENT() ;
    if ($cols{id} !~ /PRIMARY[\s_-]*KEY/si) { $cols{id} .= ' PRIMARY KEY' ;}
  }

  $this->{sql} = "CREATE TABLE $table (" ;

  my $c ;
  foreach my $order_i ( @order ) {
    if (++$c > 1) { $this->{sql} .= " , " ;}
    $this->{sql} .= "$order_i $cols{$order_i}" ;
  }

  $this->{sql} .= ")" ;

  eval { $this->dbh->do( $this->{sql} ) };

  return $this->Error("SQL error: $this->{sql}\nERROR MSG:\n$@") if $@ ;

  $this->ON_CREATE($table,\%cols,\@order) if $this->can('ON_CREATE') ;

  return 1 ;
}

#######
# CMD #
#######

sub cmd {
  my $this = shift ;

  $this->{sql} = $_[0] ;
  my $return = $_[1] ;

  $this->_undef_sth ;

  eval{
    $this->{sth} = $this->dbh->prepare( $this->{sql} ) ;
    $this->{sth}->execute ;
  };

  return $this->Error("SQL error: $this->{sql}") if $@ ;

  return $this->Return( $return ) ;
}

#########
# NAMES #
#########

sub names {
  my $this = shift ;
  my ( $table ) = @_ ;

  $table = _format_table_name($table) ;

  if (! $table) { return $this->Error('Invalid table!') ;}
  elsif ( $this->{CACHE}{names}{$table} ) { return @{ $this->{CACHE}{names}{$table} } ;}

  if ( $this->{SQL}{SHOW} ) { $this->{sql} = "SHOW COLUMNS FROM $table" ;}
  elsif ( $this->{SQL}{LIMIT} ) { $this->{sql} = "SELECT * FROM $table LIMIT 1" ;}
  else { $this->{sql} = "SELECT * FROM $table" ;}

  $this->_undef_sth ;
  eval{
    $this->{sth} = $this->dbh->prepare( $this->{sql} ) ;
    $this->{sth}->execute ;
  };

  return $this->Error("SQL error: $this->{sql}") if $@ ;

  my @names ;

  if (  $this->{SQL}{SHOW}  ) {
    while (my $ref = $this->{sth}->fetchrow_arrayref) { push(@names , @$ref[0]) ;}
  }
  else {
    ## substr() to make a copy of the value and avoid DBI bug!
    eval { @names = map { substr($_ , 0) } @{ $this->{sth}->{'NAME'} } };
    #eval { @names = @{ $this->{sth}->{'NAME'} } };
  }

  $this->_undef_sth ;

  return () if !@names ;

  if ( $this->{cache} ) {
    $this->{CACHE}{names}{$table} = \@names ;
  }

  return @names ;
}

##########
# TABLES #
##########

sub tables {
  my $this = shift ;

  my @tables = map {
    $_ =~ s/.*\.//;
    $_ =~ s/(['"`])(.*)\1/$2/gs; ## some DB return quoted.
    $_
  } $this->dbh->tables() ;

  return( sort @tables ) ;
}

###############
# TABLES_HASH #
###############

sub tables_hash {
  return map { $_ => 1 } $_[0]->tables ;
}

################
# TABLE_EXISTS #
################

sub table_exists {
  my %tables = $_[0]->tables ;
  return 1 if $tables{$_[1]} ;
  return ;
}

#################
# TABLE_COLUMNS #
#################

sub table_columns {
  my $this = shift ;
  my ( $table ) = @_ ;

  if (! $table) { $this->Error('Invalid table!') ; return ;}

  return $this->dbh->table_info($table) ;
}

########
# DROP #
########

sub drop {
  my $this = shift ;
  my ( $table ) = @_ ;

  $table = _format_table_name($table) ;

  if (! $table) { $this->Error('Invalid table!') ; return ;}

  my %tables = map { ("\L$_\E") => 1 } ($this->tables) ;
  if (! $tables{"\L$table\E"} ) { return ;}

  $this->flush_table_cache($table) ;

  eval{ $this->dbh->do("DROP TABLE $table") };

  return $this->Error("DROP ERROR: table $table") if $@ ;

  $this->ON_DROP($table) if $this->can('ON_DROP') ;

  return 1 ;
}

##############
# DUMP_TABLE #
##############

sub dump_table {
  my $this = shift ;
  my ( $table ) = @_ ;

  $table = _format_table_name($table) ;

  if (!$table) { $this->Error('Invalid table!') ; return ;}

  my $dump ;

  $dump .= "TABLE $table:\n\n" ;

  my %cols = $this->table_columns($table) ;
  my @cols = $this->names($table) ;

  foreach my $Key (@cols) {
    $dump .= "  $Key = $cols{$Key}\n" ;
  }

  $dump .= "\nROWS:\n\n" ;

  my @sel = $this->select( $table , '@$' ) ;
  foreach my $sel_i ( @sel ) {
    $dump .= "$sel_i\n" ;
  }

  return $dump ;
}

###############
# FLUSH_CACHE #
###############

sub flush_cache {
  if ( !$_[0]->{CACHE} ) { return ;}
  my @sth = $_[0]->_get_cache_sth ;
  delete $_[0]->{CACHE} ;
  foreach my $sth_i ( @sth ) { $sth_i->finish if $sth_i ;}
  return 1 ;
}

#####################
# FLUSH_TABLE_CACHE #
#####################

sub flush_table_cache {
  my $this = shift ;
  my ( $table ) = @_ ;

  $table = _format_table_name($table) ;

  if ( !$this->{CACHE} ) { return ;}

  my @sth = $this->_get_cache_table_sth($table) ;

  delete $this->{CACHE}{names}{$table} ;
  delete $this->{CACHE}{insert}{$table} ;
  delete $this->{CACHE}{update}{$table} ;

  foreach my $sth_i ( @sth ) { $sth_i->finish if $sth_i ;}

  return 1 ;
}

######################
# _FORMAT_TABLE_NAME #
######################

sub _format_table_name {
  my ( $table ) = @_ ;
  $table =~ s/(?:\.|::)/_/gs ;
  $table =~ s/[^\w\.]//gs ;
  return $table ;
}

#######################
# _FORMAT_COLUMN_NAME #
#######################

sub _format_column_name {
  my ( $col ) = @_ ;
  $col =~ s/(?:\.|::)/_/gs ;
  $col =~ s/[^\w\.]//gs ;
  return $col ;
}

##################
# _GET_CACHE_STH #
##################

sub _get_cache_sth {
  my $cache = $_[0]->{CACHE} ;
  my @types = qw(insert update) ;

  my @sth ;

  foreach my $types_i ( @types ) {
    foreach my $Key ( keys %{$$cache{$types_i}} ) {
      push(@sth , $$cache{$types_i}{$Key}{sth} ) ;
    }
  }

  return @sth ;
}

########################
# _GET_CACHE_TABLE_STH #
########################

sub _get_cache_table_sth {
  my $cache = $_[0]->{CACHE} ;
  my $table = $_[1] ;
  my @types = qw(insert update) ;

  my @sth ;

  foreach my $types_i ( @types ) {
    push(@sth , $$cache{$types_i}{$table}{sth} ) ;
  }

  return @sth ;
}

##############
# _UNDEF_STH #
##############

sub _undef_sth {
  if ( $_[0]->{sth} ) {
    $_[0]->{sth}->finish ;
    $_[0]->{sth} = undef ;
  }
}

##########
# RETURN #
##########

sub Return {
  my $this = shift ;
  my ( $return ) = @_ ;

  my $ret_names ;

  $return =~ s/\s//gs ;
  if ($return =~ /^(?:n|c)/si ) {
    $ret_names = 1 ;
    $return =~ s/[^\$\@\%<>]//gs ;
  }

  if ($return !~ /^(?:\$?[\$\@\%]{1,2}|<[\$\@\%]>)$/ ) { $return = '$' ;}

  $return =~ s/^\$\$\%$/\$\$\@/ ;
  $return =~ s/^\%\%$/\$\%/ ;

  my $sth = $_[1] || $this->{sth} ;
  return undef if !$sth ;

  if ($return =~ /<\s*([\$\@\%])\s*>\s*$/) {
    my $type = $1 ;
    local(*HANDLE);
    tie(*HANDLE, 'HDB::CMDS::TieHandle',$sth,$type) ;
    return( \*HANDLE ) ;
  }

  my $ret_type ;
  if    ($return =~ /\@$/) { $ret_type = 1 ;}
  elsif ($return =~ /\%$/) { $ret_type = 2 ;}

  my @names ;

  eval{
    my $names = $sth->{'NAME'} ;
    @names = @{$names} ;
  };

  if (! @names) { $this->_undef_sth ; return undef ;}

  my @rows ;
  while (my $ref = $sth->fetchrow_arrayref) {
    foreach my $ref_i ( @$ref ) {
      &HDB::Parser::unfilter_null_bytes($ref_i) ;

      if    ( &HDB::Encode::Is_Packed_HASH($ref_i) ) { $ref_i = &HDB::Encode::UnPack_HASH($ref_i) ;}
      elsif ( &HDB::Encode::Is_Packed_ARRAY($ref_i) ) { $ref_i = &HDB::Encode::UnPack_ARRAY($ref_i) ;}
    }
    if ($ret_type == 1) { push(@rows , [@$ref]) ;}
    elsif ($ret_type == 2) {
      my %hash ;
      for my $i (0..$#names) { $hash{ $names[$i] } = $$ref[$i] ;}
      push(@rows , \%hash) ;
    }
    else { push(@rows , join("::" , @$ref ) ) ;}
  }

  $this->_undef_sth ;

  my @ret_names ;

  if ($ret_names) { @ret_names = \@names ;}

  if ($return =~ /^[\@\%\$]$/) {
    if (wantarray) { return( @ret_names , @rows ) ;}
    else { return( $rows[0] ) ;}
  }
  elsif ($return =~ /^\$\$$/) { return( @ret_names , $rows[0] ) ;}
  elsif ($return =~ /^\$\@$/) { return( @ret_names , @{ $rows[0] } ) ;}
  elsif ($return =~ /^\$\%$/) { return( @ret_names , %{ $rows[0] } ) ;}
  elsif ($return =~ /^\$\$\@$/) {
    if    ( ref( @{$rows[0]}[0] ) eq 'HASH' )  { return( @ret_names , %{@{$rows[0]}[0]} ) ;}
    elsif ( ref( @{$rows[0]}[0] ) eq 'ARRAY' ) { return( @ret_names , @{@{$rows[0]}[0]} ) ;}
    else                                       { return( @ret_names , @{ $rows[0] } ) ;}
  }
  elsif ($return =~ /^\@[\@\%\$]$/) { return( @ret_names , @rows ) ;}
}

# $
# @
# %
# @@
# @%
# %%

############
# GET_TYPE #
############

sub get_type {
  my $this = shift ;
  my ( $type , $name ) = @_ ;

  $type =~ s/^\s+//gs ;
  $type =~ s/\s+$//gs ;

  ## *

  if ($type =~ /^(?:\*|)$/s) { $type = 'TEXT' ;}


  ## TEXT

  if ($type eq 'TEXT' || $type =~ /^(?:TEXT\s*)?(\d+|\(\s*\d+\s*\))$/s) {
    my $sz = $1 ; $sz =~ s/\D//gs ;
    $sz = 65535 if $sz eq '' ;

    if ( !$this->Accept_Type('TEXT') ) { $type = $this->Type_TEXT($sz) ;}
    else {
      if    ($sz == 0)           { $type = "INTEGER" ;}
      elsif ($sz <= 255)         { $type = "VARCHAR($sz)" ;}
      elsif ($sz <= 65535 )      { $type = 'TEXT' ;}
      elsif ($sz <= 16777215 )   { $type = 'MEDIUMTEXT' ;}
      elsif ($sz <= 4294967295 ) { $type = 'LONGTEXT ' ;}
      if ( !$this->Accept_Type($type) ) { $type = $this->Type_TEXT($sz) ;}
    }
  }

  ## INTEGER

  if ($type =~ /^(?:INTEGER|INT)\s*(?:\(?([\+\-]?\d+|\w+)\)?|)$/si) {
    my $sz = $1 ;

    if ( !$this->Accept_Type('INTEGER') ) { $type = $this->Type_INTEGER($sz) ;}
    else {
      if (!$sz) { $type = "INTEGER" ;}
      elsif ($sz =~ /^(?:t|tin|shor)/i) { $type = "TINYINT" ;}
      elsif ($sz =~ /^(?:s|sma)/i) { $type = "SMALLINT" ;}
      elsif ($sz =~ /^(?:m|med)/i) { $type = "MEDIUMINT" ;}
      elsif ($sz =~ /^(?:b|big)/i) { $type = "BIGINT" ;}
      elsif ($sz =~ /^[\+\-]?\d+$/) {
        if    ($sz >= -127 && $sz <= 127)               { $type = "TINYINT" ;}
        elsif ($sz >= -32768 && $sz <= 32767)           { $type = "SMALLINT" ;}
        elsif ($sz >= -8388608 && $sz <= 8388607)       { $type = "MEDIUMINT" ;}
        elsif ($sz >= -2147483648 && $sz <= 2147483647) { $type = "INTEGER" ;}
        elsif ($sz < -2147483648 || $sz > 2147483647)   { $type = "BIGINT" ;}
      }
      if (! $this->Accept_Type($type)) { $type = $this->Type_INTEGER($sz) ;}
    }
  }

  ## FLOAT

  elsif ($type =~ /^(\s*[\+\-]\s*(?:FLOATING|FLOAT|DOUBLE))\s*(?:\((.*?)\)|())$/si) {
    $type = $this->Type_FLOAT($1,$2) ;
  }

  ## INT

  elsif ($type =~ /\w+INT$/si) {
    if (! $this->Accept_Type($type)) { $type = 'INTEGER' ;}
  }

  ## BOOLEAN

  elsif ($type =~ /^(?:boolean|boo?l)$/si) { $type = 'BOOLEAN' ;}

  ## AUTO

  elsif ($type =~ /^(?:AUTOINCREMENT|AUTO)$/si) { $type = $this->AUTOINCREMENT() ;}

  ## DEF

  elsif ($type =~ /^(?:DEFAULT|DEF)$/si) {
    $type = $DEFAULT_COLS{$name} || 'TEXT' ;
    $type = $this->get_type($type) ;
  }

  ## TYPE MASK:

  if ( $this->{SQL}{TYPES_MASK} && $this->{SQL}{TYPES_MASK}{$type} ) {
    $type = $this->{SQL}{TYPES_MASK}{$type} ;
  }

  return( $type ) ;
}

##################
# SET_PRIMARYKEY #
##################

sub Set_PRIMARYKEY {
  my $this = shift ;
  my ( $type ) = @_ ;

  my $primarykey = $this->PRIMARYKEY() ;
  my $primarykey_re = $primarykey ;
  $primarykey_re =~ s/\s+/\\s\+/gs ;

  if ($type !~ /$primarykey_re/si) { $type .= " $primarykey" ;}

  return( $type ) ;
}

###############
# ACCEPT_TYPE #
###############

sub Accept_Type {
  my $this = shift ;
  my $type = "\L$_[0]\E" ;

  if (ref($this->{SQL}{TYPES}) eq 'ARRAY') {
    my %types = map { ("\L$_\E") => 1 } @{ $this->{SQL}{TYPES} } ;
    $this->{SQL}{TYPES} = \%types ;
  }

  if ( $this->{SQL}{TYPES}{$type} || $this->{SQL}{TYPES}{'*'} ) { return( 1 ) ;}
  return( undef ) ;
}

########################
# HDB::CMDS::TIEHANDLE #
########################

package HDB::CMDS::TieHandle ;

sub TIEHANDLE {
  my $class = shift ;
  my $this = { sth => $_[0] , type => $_[1] } ;
  bless($this , $class) ;
}

sub READLINE  {
  my $this = shift ;
  my $sth = $this->{sth} ;

  if ($this->{type} eq "\$") {
    my $ref = $sth->fetchrow_arrayref ; return if !$ref ;
    return( join("::" , @$ref ) ) ;
  }
  elsif ($this->{type} eq "\@") {
    my $ref = $sth->fetchrow_arrayref ; return if !$ref ;
    foreach my $ref_i ( @$ref ) {
      &HDB::Parser::unfilter_null_bytes($ref_i) ;

      if    ( &HDB::Encode::Is_Packed_HASH($ref_i) ) { $ref_i = &HDB::Encode::UnPack_HASH($ref_i) ;}
      elsif ( &HDB::Encode::Is_Packed_ARRAY($ref_i) ) { $ref_i = &HDB::Encode::UnPack_ARRAY($ref_i) ;}
    }
    return( @$ref ) ;
  }
  elsif ($this->{type} eq "\%") {
    my $ref = $sth->fetchrow_hashref ; return if !$ref ;
    foreach my $Key ( keys %$ref ) {
      &HDB::Parser::unfilter_null_bytes($$ref{$Key}) ;

      if    ( &HDB::Encode::Is_Packed_HASH($$ref{$Key}) ) { $$ref{$Key} = &HDB::Encode::UnPack_HASH($$ref{$Key}) ;}
      elsif ( &HDB::Encode::Is_Packed_ARRAY($$ref{$Key}) ) { $$ref{$Key} = &HDB::Encode::UnPack_ARRAY($$ref{$Key}) ;}
    }
    return( %$ref ) ;
  }

  return ;
}

sub DESTROY  {

}

#######
# END #
#######

1;

__END__