Perl-PrereqScanner-NotQuiteLite

 view release on metacpan or  search on metacpan

t/scan/pod.t  view on Meta::CPAN

      'unique_max'        => 1000,
      'primary_max'       => 999,
      'fulltext_max'      => 1000,
      'err_connection'    => [qw( 1 1040 1053 1129 1213 1226 2002 2003 2006 2013 )],
      'err_fatal'         => [qw( 1016 1046 1251 )],                                   # 1045,
      'err_syntax'  => [qw( 1054 1060 1064 1065 1067 1071 1096 1103 1118 1148 1191 1364 1366 1406 1439)],  #maybe all 1045..1075
      'err_repair'  => [qw( 126 130 144 145 1034 1062 1194 1582 )],
      'err_retry'   => [qw( 1317 )],
      'err_install' => [qw( 1146 )],
      'err_install_db' => [qw( 1049 )],
      'err_ignore '    => [qw( 2 1264 )],
      '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)) {
          #$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(@_);



( run in 1.826 second using v1.01-cache-2.11-cpan-39bf76dae61 )