WWWWWW

Current Directory: /home/.cpanm/work/1729881454.851640/HDB-1.05/lib/HDB
Viewing File: /home/.cpanm/work/1729881454.851640/HDB-1.05/lib/HDB/CMDS.pm
#############################################################################
## 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} =~ /</s) { $sort .= ' DESC' ;}
    }
    #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__

=head1 NAME

HDB::CMDS - Hybrid DataBase Commands

=head1 DESCRIPTION

This are the commands/methods to access/manage the databases.

=head1 select

Make a SQL select query.

Example:

  my @sel = $HDB->select('users' , 'name =~ joe' , '@%') ; ## table , where , return
  
  ## ... or ...
  
  my @sel = $HDB->select('users' , 'name =~ joe' , cols => 'name,user,id' , limit => 1 , '@%') ;
  
  ## ... or ...
  
  my @sel = $HDB->select(
  table  => 'users' ,           ## Need to start with 'table' to paste a full HASH of arguments!
  where  => 'name == joe' ,
  col    => 'name, user , id' ,
  limit  => '1' ,
  sort   => 'id' ,
  group  => 'name' ,
  cache  => '0' ,
  return => '@%' ,  
  ) ;
  

B<Arguments:>

=over 10

=item TABLE

The table name.

=item WHERE

Where condintion. See the topic 'WHERE' for format.

=item COL

Columns to return and order, separated by ','.

Example:

  col => 'city'        # Return only the column city.
  col => 'city,state'  # Return the column city and state in this order.
  col => '>ID'         # Return the max ID.
  col => '<ID'         # Return the min ID.


=item LIMIT

Limit of return or/and start of returns.

Example:

  limit => '10'    # Make the limit of returns to 10.
  limit => '10,2'  # Make the limit of returns to 10 and the returns will start from 2.
  limit => '0,2'   # Returns will start from 2.

=item SORT

Column to use for sort (order). If > or < is used in the beggin set the ascending or descending sort.

Example:

  sort => 'ID'   # Sort by ID in the ascending order.
  sort => '>ID'  # Sort by ID in the ascending order.
  sort => '<ID'  # Sort by ID in the *descending order.

=item GROUP

Column(s) to group.

Example:

  group => 'city'          # Group only the col city
  group => 'city , state'  # Group the col city and state.


=item CACHE

Turn on/off the cache of sth and col names.

=item RETURN

The return type. See the topic L</RETURN> for format.

=back

=head1 insert ( table , data )

Insert data inside a table.

You can call it sending the data by column order or hash (by column name):

  # Cols of table users: name , email , id

  $HDB->insert( 'users' , 'joe' , 'joe@mail.com' , 1 );
  
  # Or with a hash:
  
  $HDB->insert( 'users' , {
  'name' => 'joe' ,
  'email' => 'joe@mail.com' ,
  'id' => 1 ,
  } );

=head1 update ( table , where , data )

Update a table. The data need to be a HASH or a ref to a HASH:

  $HDB->update( 'users' , 'user == joe' , {
  name => 'Joe Tribiany' ,
  email => 'foo@mail.com' ,
  } );
  
  # Or:
  
  $HDB->update( 'users' , 'user == joe' , name => 'Joe Tribiany' , email => 'foo@mail.com' );

=head1 delete ( table , where )

Delete entrys of a table:

  $HDB->delete( 'users' , 'user == joe' );

=head1 create ( table , columns )

Create a new tables. You send the columns in the order that they will be in the table, and the TYPES are based in the size:

  $HDB->create( 'users' ,
  user  => 100 ,            # A col for strings, with the max size 100.
  name  => 150 ,            # A col for strings, with the max size 150.
  more  => 4096 ,           # A col for strings, with the max size 4Kb.
  more2 => 1048576          # A col for strings, with the max size 1Mb.
  more3 => '*'              # A col for strings.
  age   => 'int(200)' ,     # A col for numbers, with the max number 200.
  numb  => 'float' ,        # A floating point with normal precision.
  numb1 => 'double' ,       # A floating point with big precision.
  numb2 => 'float(10)' ,    # A floating point with precision 10.
  numb3 => '+float(10,4)' , # for floating points. This will be unsigned (only positive values).
                            # 10 is the max digit size (including decimal).
                            # 4 is the precision (number digits after decimal point).
  adm   => bool ,           # For boolean entrys.
  );
  
  ** FLOAT is not enable in any database, and can be changed to INTEGER. The precision and UNSIGNED options are not enabled for all too.
  ** Use FLOAT for normal precision, and DOUBLE for big precision for portable way.
  
In MySQL the cols type will be:

  $HDB->create( 'users' ,
  user  => 100 ,            # VARCHAR(100)
  name  => 150 ,            # VARCHAR(150)
  more  => 4096 ,           # TEXT
  more2 => 1048576          # MEDIUMTEXT
  more3 => '*'              # TEXT
  age   => 'int(200)' ,     # SMALLINT
  numb  => 'float' ,        # FLOAT
  numb1 => 'double' ,       # DOUBLE
  numb2 => 'float(10)' ,    # FLOAT(10)
  numb3 => '+float(10,4)' , # FLOAT(10,4) UNSIGNED
  adm   => bool ,           # BOOLEAN
  );
  
In SQLite the cols type will be:

  $HDB->create( 'users' ,
  user  => 100 ,            # VARCHAR(100)
  name  => 150 ,            # VARCHAR(150)
  more  => 4096 ,           # TEXT
  more2 => 1048576          # TEXT
  more3 => '*'              # TEXT
  age   => 'int(200)' ,     # INTEGER
  numb  => 'float' ,        # FLOAT
  numb1 => 'double' ,       # FLOAT
  numb2 => 'float(10)' ,    # FLOAT
  numb3 => '+float(10,4)' , # FLOAT
  adm   => bool ,           # BOOLEAN  
  );

B<** Note that the column ID will be always created and will be AUTOINCREMENT, unless you set the type by your self.>

You can use predefined col names (templates) for the columns. This is good if you don't want to think in the size that the type of data can have:

  $HDB->create( 'users' ,
  user  => 100 ,
  ['email'] ,      # The predefined col name. Same as:   email => 50
  name  => 150 ,
  );

=head1 drop ( table )

Drop (remove) a table:

  $HDB->drop( 'users' );

=head1 cmd ( SQL , RETURN )

Send a SQL query to the database. The return will be in the format of the argument RETURN:

  my @sel = $HDB->cmd('select * from users','@%');


=head1 dump_table

Return a string with the table dumped.

=head1 tables

Return an ARRAY with tables of the database.

=head1 table_exists ( TABLE )

Return TRUE if TABLE exists.

=head1 tables_hash

Same as tables(), but return a HASH, with the tables as keys and 1 as values.
Good if you want to make: if ($tables{users}) {...}

=head1 table_columns

Return a HASH with the columns and respective type (based in the DB type).

=head1 names

Return an ARRAY with the names of the columns in the table, with the respective order.

=head1 sql

Return the last SQL command sent to the DB.

=head1 flush_cache

Clean the HDB cache (in the HDB object, not in the database).

=head1 flush_table_cache

Clean the HDB cache of a table (in the HDB object, not in the database).

=head1 get_type

Convert the HDB type to the database type:

  my $db_col_type = $HDB->get_type( 1000 );
  
  ...
  
  my $db_col_type = $HDB->get_type( 'int(200)' );

=head1 default_types

Return a list of the default types of HDB.

=head1 predefined_columns

Return a HASH with the predefined columns and sets.

=head1 default_mod

Return a HASH with the HDB::MOD installed by default in this version.

The HASH:

  keys   => full name.
  values => id for HDB.

=head1 RETURN

Commands like select has a return argument, that will tell how to format the results and the type of the variable.

The return has 2 parts.

First, the type of the variable (@|$):

  @ >> Will return an array.
  $ >> Will return the first line of the results (row), or the parsed reference of the 2nd part.
  
  ** If the first part is omitted, @ will be used.

Second, the format ($|@|%):

  $ >> The rows will have the columns separated by '::', like:  joe::joe@mail.com::1
  @ >> The cols of each row will be inside an ARRAY.
  % >> The cols of each row will be inside a HASH.

Examples:

  return => '@$'   # Will return an ARRAY, with the cols in each line of the array separated by '::'.
  return => '@@'   # Will return an ARRAY of ARRAYS (with the cols in the SUB-ARRAY).
  return => '@%'   # Will return an ARRAY of HASHES (with the cols in the HASH).

  return => '$$'   # Will return the cols of the first result (row) separated by '::'. (return a sinlge SCALAR)
  return => '$@'   # Will return the cols of the first result (row) inside an ARRAY. (return a sinlge ARRAY)
  return => '$%'   # Will return the cols of the first result (row) inside a HASH. (return a sinlge HASH)
  
  return => '$$@'  # Special case: Parse the encoded ref of the first col in the first row. See HDB::Encode.
  return => '$$%'  # Same as $$@.

  return => '<$>'  # Special: Parse sth row by row, returning a SCALAR, with the columns separated by '::'.
  return => '<@>'  # Special: Parse sth row by row, returning a ARRAY with the values of the columns.
  return => '<%>'  # Special: Parse sth row by row, returning a HASH of columns and values.
  
  return => '$'    # Like @$
  return => '@'    # Like @@
  return => '%'    # Like @%

  return => '%%'   # Like $%

If you want the list of columns returned, put NAMES in the begin of return:

  return => 'NAMES,@@'  # Will return the reference to an ARRAY with the columns names and the ARRAY of ARRAYS.
  
  ## USAGE:
  my ($cols_names , @sel) = $HDB->select('users','NAMES,@%') ;
  my @cols_names = @$cols_names ;

The best way to think in the I<RETURN> type is to think in what variable type will receive the result,
and in what type you want the informations inside the result.

  ## For an ARRAY receiveing and for informations in HASH type: @%
  my @sel = $HDB->select('users','@%') ;
  print "$sel[0]{name}\n" ;
  
  ## For a SCALAR receiveing and for informations in ARRAY type: $@
  my $name = $HDB->select('users', col => 'name' , '$@') ;
  
  ## For a HASH receiveing and for informations in HASH type: %%
  my %user = $HDB->select('users', "id == 1" '%%') ; ## return only 1 row!
  print "$user{name}\n" ;

=head2 RETURN USAGE (Code Examples):

  my @sel = $HDB->select( table => users , return => '@$' );
  
  foreach my $sel_i ( @sel ) {
    my @cols = split("::" , $sel_i) ;
    ...
  }
  
  ##########################################################

  my @sel = $HDB->select( table => users , return => '@@' );
  
  foreach my $sel_i ( @sel ) {
    my @cols = @$sel_i ;
    ...
  }
  
  ##########################################################

  my @sel = $HDB->select( table => users , return => '@%' );
  
  foreach my $sel_i ( @sel ) {
    my %cols = %$sel_i ;
    ...
  }
  
  ##########################################################

  my ($names,@sel) = $HDB->select( table => users , return => 'NAMES,@%' );
  my @names = @$names ;

  foreach my $sel_i ( @sel ) {
    my %cols = %$sel_i ;
    ...
  }
  
  ##########################################################

  my %hash = $HDB->select( table => users , col => 'encoded' , return => '$$@' );
  
  foreach my $Key ( keys %hash ) {
    my $Value = $hash{$Key} ;
    print "$Key = $Value\n" ;
  }
  
  ##########################################################
  
  my $hdbhandle = $HDB->select( table => users , return => '<$>' );
  
  while( my $row = <$hdbhandle> ) {
    my @cols = split("::" , $row) ;
    ...
  }
  
  ##########################################################
  
  my $hdbhandle = $HDB->select( table => users , return => '<@>' );
  
  while( my @cols = <$hdbhandle> ) {
    ...
  }
  
  ##########################################################
  
  my $hdbhandle = $HDB->select( table => users , return => '<%>' );
  
  while( my %cols = <$hdbhandle> ) {
    foreach my $Key ( keys %cols ) { print "$Key = $cols{$Key}\n" ;}
    ...
  }
  
  ##########################################################

  my $sel_row_0 = $HDB->select( table => users , return => '$$' );
  my @cols = split("::" , $sel_row_0) ;
  
  ##########################################################

  my @cols = $HDB->select( table => users , return => '$@' ); ## Return ROW 0.
  
  ##########################################################

  my %cols = $HDB->select( table => users , return => '$%' ); ## Return ROW 0.
  

=head1 SEE ALSO

L<HDB>, L<HDB::Encode>, L<HDB::sqlite>, L<HDB::mysql>.

=head1 AUTHOR

Graciliano M. P. <gm@virtuasites.com.br>

=head1 COPYRIGHT

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
F1l3 Manager
