view release on metacpan or  search on metacpan

lib/Net/DirectConnect/pslib/pssql.pm  view on Meta::CPAN

      'row quote'        => '"',
      'value quote'      => "'",
      'index_name_table' => 1,
      'REPLACE'          => 'INSERT',
      'EXPLAIN'          => 'EXPLAIN ANALYZE',
      'CASCADE'          => 'CASCADE',
      'SET NAMES'        => 'SET client_encoding = ',
      'fulltext_config'  => 'pg_catalog.simple',
      'params'           => [
        qw(host hostaddr port options dbname database db user username password service sslmode), qw(
          )
      ],
      'err_ignore' => [qw( 1 7)],
      'error_type' => sub {
        my $self = shift, my ( $err, $errstr ) = @_;
        #$self->log('dev',"ERRDETECT($err, [$errstr])");
        return 'connection' if $errstr eq $err; # 7, [7] # wtf
        return 'install_db' if $errstr =~ /FATAL:\s*database ".*?" does not exist/i;
        return 'connection' if $errstr =~ /FATAL:\s*terminating connection/i; #7
        return 'fatal'      if $errstr =~ /fatal/i;
        return 'syntax'     if $errstr =~ /syntax/i;
        return 'connection' if $errstr =~ /ERROR:\s*prepared statement ".*?" does not exist/i;
        return 'connection' if $errstr =~ /connect|Unknown message type: ''/i and $errstr !~ /(?:column|relation) "/; #"mc
        return 'install'    if $errstr =~ /ERROR:\s*(?:relation \S+ does not exist)/i;
        #return 'retry'    if $errstr =~       /ERROR:\s*cannot drop the currently open database/i;
        return 'retry' if $errstr =~ /ERROR:  database ".*?" is being accessed by other users/i;
        return 'ignore'
          if $errstr =~
/(?:duplicate key violates unique constraint)|(?:duplicate key value violates unique constraint)|(?:ERROR:\s*(?:database ".*?" already exists)|(?:relation ".*?" already exists)|(?:invalid byte sequence for encoding)|(?:function .*? does not exist)|(?...
        return undef;
      },
      'set'        => { 'lc_messages' => 'C' },
      'on_connect' => sub {
        my $self = shift;
        $self->{dbh}->{pg_utf8_strings} = $self->{dbh}->{pg_enable_utf8} = 1;
        $self->set_names();
        $self->do("select set_curcfg('default');") if $self->{'use_fulltext'} and $self->{'old_fulltext'};
        $self->do("SET $_=$vq$self->{'set'}{$_}$vq;") for grep {!$self->{'no_set_'.$_}} sort keys %{ $self->{'set'} || {} };
      },
      'no_dbirows'         => 1,
      'cp1251'             => 'win1251',
      'fulltext_word_glue' => '&',
    },
    'sphinx' => {
      'dbi'                     => 'mysql',
      'user'                    => 'root',
      'port'                    => 9306,
      'params'                  => [qw(host port )],                                                        # perldoc DBD::mysql
      'sphinx'                  => 1,
      'value quote'             => "'",
      'no_dbirows'              => 1,
      'no_column_prepend_table' => 1,
      'no_join'                 => 1,
      'OPTION'                  => 'OPTION',
      'option'                  => { 'max_query_time' => 20000, 'cutoff' => 1000, 'ranker' => 'sph04', },
    },
    'mysql5' => {
      'dbi'               => 'mysql',
      'user'              => 'root',
      'use_drh'           => 1,
      'mysql_enable_utf8' => 1,
      'varchar_max'       => 65530,
      'unique_max'        => 1000,
      'primary_max'       => 999,
      'fulltext_max'      => 1000,
      'key_length'        => 1000, # maybe 3072 for mariadb
      'err_connection'    => [qw( 1 1040 1053 1129 1213 1226 2002 2003 2006 2013 )],
      'err_fatal'         => [qw( 1016 1046 1251 )],                                   # 1045,
      'err_syntax'  => [qw( 1060 1064 1065 1067 1071 1096 1103 1118 1148 1191 1364 1366 1406 1439)], #1054 #maybe all 1045..1075
      'err_repair'  => [qw( 126 130 144 145 1034 1062 1194 1582 )],
      'err_retry'   => [qw( 1317 )],
      'err_install' => [qw( 1146)], # 1017 repair?
      'err_install_db' => [qw( 1049 )],
      'err_upgrade'    => [qw( 1054 )],
      'err_ignore '    => [qw( 2 1264 1061 )],
      'error_type'     => sub {
        my $self = shift, my ( $err, $errstr ) = @_;
        #$self->log('dev',"MYERRDETECT($err, $errstr)");
        for my $errtype (qw(connection retry syntax fatal repair install install_db upgrade)) {
          #$self->log('dev',"ERRDETECTED($err, $errstr) = $errtype"),
          return $errtype if grep { $err eq $_ } @{ $self->{ 'err_' . $errtype } };
        }
        return undef;
      },
      'table quote' => "`",
      'row quote'   => "`",
      'value quote' => "'",
      #'index quote'		=> "`",
      #'unsigned'                => 1,
      'quote_slash'             => 1,
      'index in create table'   => 1,
      'utf-8'                   => 'utf8',
      'koi8-r'                  => 'koi8r',
      'table options'           => 'ENGINE = MYISAM DELAY_KEY_WRITE=1',
      'IF NOT EXISTS'           => 'IF NOT EXISTS',
      'IF EXISTS'               => 'IF EXISTS',
      'IGNORE'                  => 'IGNORE',
      'REPLACE'                 => 'REPLACE',
      'INSERT'                  => 'INSERT',
      'HIGH_PRIORITY'           => 'HIGH_PRIORITY',
      'SET NAMES'               => 'SET NAMES',
      'DEFAULT CHARACTER SET'   => 'DEFAULT CHARACTER SET',
      'USE_FRM'                 => 'USE_FRM',
      'EXTENDED'                => 'EXTENDED',
      'QUICK'                   => 'QUICK',
      'ON DUPLICATE KEY UPDATE' => 'ON DUPLICATE KEY UPDATE',
      'UNSIGNED'                => 'UNSIGNED',
      'UNLOCK TABLES'           => 'UNLOCK TABLES',
      'LOCK TABLES'             => 'LOCK TABLES',
      'OPTIMIZE'                => 'OPTIMIZE TABLE',
      'ANALYZE'                 => 'ANALYZE TABLE',
      'CHECK'                   => 'CHECK TABLE',
      'FLUSH'                   => 'FLUSH TABLE',
      'LOW_PRIORITY'            => 'LOW_PRIORITY',
      'on_connect'              => sub {
        my $self = shift;
        $self->{'db_id'} = $self->{'dbh'}->{'mysql_thread_id'};
        $self->set_names() if !( $ENV{'MOD_PERL'} || $ENV{'FCGI_ROLE'} );
      },
      'on_user' => sub {
        my $self = shift;
        $self->set_names() if $ENV{'MOD_PERL'} || $ENV{'FCGI_ROLE'};
      },
      'params' => [
        qw(host port database mysql_client_found_rows mysql_compression mysql_connect_timeout mysql_read_default_file mysql_read_default_group mysql_socket
          mysql_ssl mysql_ssl_client_key mysql_ssl_client_cert mysql_ssl_ca_file mysql_ssl_ca_path mysql_ssl_cipher
          mysql_local_infile mysql_embedded_options mysql_embedded_groups mysql_enable_utf8)
      ],    # perldoc DBD::mysql
      'insert_by' => 1000, ( !$ENV{'SERVER_PORT'} ? ( 'auto_check' => 1 ) : () ), 'unique name' => 1,    # test it
      'match' => sub {
        my $self = shift;
        my ( $param, $param_num, $table, $search_str, $search_str_stem ) = @_;
        my ( $ask, $glue );
        local %_;
        map { $_{ $self->{'table'}{$table}{$_}{'fulltext'} } = 1 }
          grep { $self->{'table'}{$table}{$_}{'fulltext'} or ( $self->{'sphinx'} and $self->{'table'}{$table}{$_}{'sphinx'} ) }
          keys %{ $self->{'table'}{$table} };
        for my $index ( keys %_ ) {
          if (
            $_ = join( ' , ',
              map  { "$rq$_$rq" }
              sort { $self->{'table'}{$table}{$b}{'order'} <=> $self->{'table'}{$table}{$a}{'order'} }
              grep { $self->{'table'}{$table}{$_}{'fulltext'} eq $index } keys %{ $self->{'table'}{$table} } )
            )
          {
            my $stem =
              grep { $self->{'table'}{$table}{$_}{'fulltext'} eq $index and $self->{'table'}{$table}{$_}{'stem_index'} }
              keys %{ $self->{'table'}{$table} };
            #TODO: maybe some message for user ?
            $self->{'accurate'} = 1, next,
              if ($stem
              and length $search_str_stem
              and $self->{'auto_accurate_on_slow'}
              and $search_str_stem =~ /\b\w{$self->{'auto_accurate_on_slow'}}\b/ );
            my $double =
              grep { $self->{'table'}{$table}{$_}{'fulltext'} and $self->{'table'}{$table}{$_}{'stem'} }
              keys %{ $self->{'table'}{$table} };
            next if $double and ( $self->{'accurate'} xor !$stem );
            my $match;
            if ( $self->{'sphinx'} ) { $match = ' MATCH (' . $self->squotes( $stem ? $search_str_stem : $search_str ) . ')' }
            else {
              $match = ' MATCH (' . $_ . ')' . ' AGAINST (' . $self->squotes( $stem ? $search_str_stem : $search_str ) . (
                ( !$self->{'no_boolean'} and $param->{ 'adv_query' . $param_num } eq 'on' )
                ? 'IN BOOLEAN MODE'
                  #: ( $self->{'allow_query_expansion'} ? 'WITH QUERY EXPANSION' : '' )
                : $self->{'fulltext_extra'}
              ) . ') ';
            }
            $ask .= " $glue " . $match;
            $work{'what_relevance'}{$table} ||= $match . " AS $rq" . "relev$rq"
              if $self->{'select_relevance'}
                or $self->{'table_param'}{$table}{'select_relevance'};
          }
          $glue = $self->{'fulltext_glue'};
        }
        return $ask;
      },
    },
  );
}

sub new {
  my $self = bless( {}, shift );
  $self->init(@_);
  $self->psconn::init(@_);
  return $self;
}