App-DBBrowser

 view release on metacpan or  search on metacpan

lib/App/DBBrowser/Auxil.pm  view on Meta::CPAN

sub unquote_identifier {
    my ( $sf, $identifier ) = @_;
    my $qc = quotemeta( $sf->{d}{identifier_quote_char} );
    $identifier =~ s/$qc(?=(?:$qc$qc)*(?:[^$qc]|\z))//g;
    return $identifier;
}


sub quote_if_not_numeric {
    my ( $sf, $value ) = @_;
    if ( looks_like_number $value ) {
        return $value;
    }
    else {
        return $sf->{d}{dbh}->quote( $value );
    }
}

lib/App/DBBrowser/Table/Extensions.pm  view on Meta::CPAN

            );
            $ax->print_sql_info( $info );
            if ( ! defined $value ) {
                return if @$extensions = 1;
                next EXTENSION;
            }
            # return if ! length $value; ##
            if ( $opt->{is_numeric} ) {
                if ( $opt->{is_numeric} == -1 ) {
                    # -1: unknown data type
                    return $ax->quote_if_not_numeric( $value );
                }
                else {
                    #return $value; # then change the documentation
                    return $ax->quote_if_not_numeric( $value );
                }
            }
            else {
                return $sf->{d}{dbh}->quote( $value );
            }
        }
        elsif ( $extension eq $e_subquery ) {
            my $new_sq = App::DBBrowser::From::Subquery->new( $sf->{i}, $sf->{o}, $sf->{d} );
            my $subq = $new_sq->subquery( $sql, $info );
            if ( ! defined $subq ) {

lib/App/DBBrowser/Table/Extensions/ScalarFunctions/GetArguments.pm  view on Meta::CPAN

                $history = [ '%', '_', '*', '?', '|' ];
            }
            my $value = $tr->readline(
                'Value: ',
                { info => $tmp_info, history => $history }
            );
            if ( ! defined $value ) {
                next COLUMNS;
            }
            push @bu, [ @$subset ];
            push @$subset, $ax->quote_if_not_numeric( $value );
        }
        else {
            push @bu, [ @$subset ];
            $sf->__add_chosen_cols_to_subset( $sql, $clause, $subset, [ @{$menu}[@idx] ], $r_data );
        }
    }
}


sub __add_chosen_cols_to_subset {

lib/App/DBBrowser/Table/Substatement/Condition.pm  view on Meta::CPAN

}


sub __add_operator_and_value {
    my ( $sf, $sql, $clause, $stmt, $col, $r_data ) = @_;
    my $driver = $sf->{i}{driver};
    my $dbms = $sf->{i}{dbms};
    my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my @operators = @{$sf->{o}{G}{operators}};
    my $not_equal = ( any { $_ =~ /^\s?!=\s?\z/ } @operators ) ? "!=" : "<>";
    if ( ! length $col ) {
        $sql->{$stmt} =~ s/\s\z//;
        @operators = ( "EXISTS", "NOT EXISTS" );
    }
    elsif ( $dbms eq 'SQLite' ) {
        @operators = grep { ! /^(?:ANY|ALL)\z/ } @operators;
        @operators = grep { ! /REGEXP/ } @operators if $driver eq 'ODBC';
    }
    elsif ( $dbms eq 'Firebird' ) {
        @operators = uniq map { s/REGEXP(?:_i)?\z/SIMILAR TO/; $_ } @operators;

lib/App/DBBrowser/Table/Substatement/Condition.pm  view on Meta::CPAN

                { %{$sf->{i}{lyt_h}}, info => $info }
            );
            $ax->print_sql_info( $info );
            if ( ! defined $operator ) {
                $sql->{$stmt} = $bu_stmt;
                return;
            }
        #}
        $operator =~ s/^\s+|\s+\z//g;
        if ( $operator =~ /(?:REGEXP(?:_i)?|SIMILAR\sTO)\z/ ) {
            my $not_match = $operator =~ /^NOT/ ? 1 : 0;
            my $case_sensitive = $operator =~ /REGEXP_i\z/ ? 0 : 1;
            my $regex_op = $sf->__pattern_match( $sql, $col, $not_match, $case_sensitive );
            if ( ! $regex_op ) {
                next OPERATOR if @operators > 1;
                return;
            }
            $sql->{$stmt} =~ s/ (?: (?<=\() | \s ) \Q$col\E \z //x;
            if ( $sql->{$stmt} =~ /\(\z/ ) {
                $regex_op =~ s/^\s//;
            }
            $sql->{$stmt} .= $regex_op;
        }
        elsif ( $operator =~ /^(?:ALL|ANY)\z/) {
            my @comb_op = ( "= $operator", "$not_equal $operator", "> $operator", "< $operator", ">= $operator", "<= $operator" );
            my @pre = ( undef );
            my $info = $sf->__info_add_condition( $sql, $stmt, $r_data );
            # Choose
            $operator = $tc->choose(
                [ @pre, @comb_op ],
                { %{$sf->{i}{lyt_h}}, info => $info }
            );
            $ax->print_sql_info( $info );
            if ( ! defined $operator ) {
                next OPERATOR if @operators > 1;

lib/App/DBBrowser/Table/Substatement/Condition.pm  view on Meta::CPAN

                next COL;
            }
            $col = $complex_col;
        }
        return $col;
    }
}


sub __pattern_match {
    my ( $sf, $sql, $col, $not_match, $case_sensitive ) = @_;
    my $dbms = $sf->{i}{dbms};
    if ( $dbms eq 'SQLite' ) {
        if ( $not_match ) {
            return sprintf " NOT REGEXP(?,%s,%d)", $col, $case_sensitive;
        }
        else {
            return sprintf " REGEXP(?,%s,%d)", $col, $case_sensitive;
        }
    }
    elsif ( $dbms =~ /^(?:mysql|MariaDB)\z/ ) {
        if ( $not_match ) {
            return " $col NOT REGEXP"        if ! $case_sensitive;
            return " $col NOT REGEXP BINARY" if   $case_sensitive;
        }
        else {
            return " $col REGEXP"        if ! $case_sensitive;
            return " $col REGEXP BINARY" if   $case_sensitive;
        }
    }
    elsif ( $dbms eq 'Pg' ) {
        my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
        my $col = $ax->pg_column_to_text( $sql, $col );
        if ( $not_match ) {
            return " $col !~*" if ! $case_sensitive;
            return " $col !~"  if   $case_sensitive;
        }
        else {
            return " $col ~*" if ! $case_sensitive;
            return " $col ~"  if   $case_sensitive;
        }
    }
    elsif ( $dbms eq 'Firebird' ) {
        if ( $not_match ) {
            return " $col NOT SIMILAR TO ? ESCAPE '\\'";
        }
        else {
            return " $col SIMILAR TO ? ESCAPE '\\'";
        }
    }
    elsif ( $dbms =~ /^(?:DB2|Oracle|MSSQL)\z/ ) {
        if ( $not_match ) {
            return " NOT REGEXP_LIKE($col,?,'i')" if ! $case_sensitive;
            return " NOT REGEXP_LIKE($col,?,'c')" if   $case_sensitive;
        }
        else {
            return " REGEXP_LIKE($col,?,'i')" if ! $case_sensitive;
            return " REGEXP_LIKE($col,?,'c')" if   $case_sensitive;
        }
    }
}