App-Repository

 view release on metacpan or  search on metacpan

lib/App/Repository/DBI.pm  view on Meta::CPAN

            $sth->finish if ($endrow > 0 && $rownum > $endrow);
        }
        else {
            # return $sth->_fetchall_arrayref;
            $rownum = 0;
            while ($row = $sth->fetch) {
                $rownum++;
                last if ($endrow > 0 && $rownum > $endrow);
                push @rows, [ @$row ] if ($rownum >= $startrow);
            }
            $sth->finish if ($endrow > 0 && $rownum > $endrow);
        }
    }
    elsif ($mode eq 'HASH') {
        if (keys %$slice) {
            my @o_keys = keys %$slice;
            my @i_keys = map { lc } keys %$slice;
            $rownum = 0;
            while ($row = $sth->fetchrow_hashref('NAME_lc')) {
                my %hash;
                @hash{@o_keys} = @{$row}{@i_keys};
                $rownum++;
                last if ($endrow > 0 && $rownum > $endrow);
                push @rows, \%hash if ($rownum >= $startrow);
            }
            $sth->finish if ($endrow > 0 && $rownum > $endrow);
        }
        else {
            # XXX assumes new ref each fetchhash
            while ($row = $sth->fetchrow_hashref()) {
                $rownum++;
                last if ($endrow > 0 && $rownum > $endrow);
                push @rows, $row if ($rownum >= $startrow);
            }
            $sth->finish if ($endrow > 0 && $rownum > $endrow);
        }
    }
    else { Carp::croak("fetchall_arrayref($mode) invalid") }
    &App::sub_exit(\@rows) if ($App::trace);
    return \@rows;
}

######################################################################
# SQL CREATE METHODS (new methods not defined in App::Repository)
######################################################################

sub _mk_where_clause {
    &App::sub_entry if ($App::trace);
    my ($self, $table, $params, $options) = @_;
    my ($where, $column, $param, $value, $colnum, $repop, $sqlop, $column_def, $quoted);
    my ($tabledef, $tabcols, $alias, $dbexpr);

    my $dbh = $self->{dbh};

    $tabledef = $self->{table}{$table};
    $alias    = $tabledef->{alias};
    $tabcols  = $tabledef->{column};
    my %sqlop = (
        "contains"     => "like",
        "matches"      => "like",
        "not_contains" => "not like",
        "not_matches"  => "not like",
        "eq"           => "=",
        "ne"           => "!=",
        "le"           => "<=",
        "lt"           => "<",
        "ge"           => ">=",
        "gt"           => ">",
        "in"           => "in",
        "not_in"       => "not in",
    );
    my %repop = (
        "=~" => "contains",
        "~"  => "contains",
        "!~" => "not_contains",
        "==" => "eq",
        "="  => "eq",
        "!"  => "ne",
        "!=" => "ne",
        "<=" => "le",
        "<"  => "lt",
        ">=" => "ge",
        ">"  => "gt",
        "=/" => "regexp",
        "/"  => "regexp",
        "!/" => "not_regexp",
    );

    $where = "";
    $params = {} if (!$params);
    my $param_order = $params->{"_order"};
    if (!defined $param_order && ref($params) eq "HASH") {
        $param_order = [ (keys %$params) ];
    }
    if (defined $param_order && $#$param_order > -1) {
        my ($include_null, $inferred_op, @where);
        for ($colnum = 0; $colnum <= $#$param_order; $colnum++) {
            $param = $param_order->[$colnum];
            $column = $param;
            $sqlop = "=";
            $repop = "";
            $inferred_op = 1;
            # check if $column contains an embedded operation, i.e. "name.eq", "name.contains"
            if ($param =~ /^(.*)\.([^.]+)$/) {
                $repop = $2;
                $inferred_op = 0;
                if ($sqlop{$repop}) {
                    $column = $1;
                    $sqlop = $sqlop{$repop};
                }
            }
            $value = $params->{$param};
            if (!$repop && $value && $value =~ s/^(=~|~|!~|==|=|!=|!|<=|<|>=|>)//) {
                $repop = $repop{$1};
                $sqlop = $sqlop{$repop};
                $inferred_op = 0 if ($1 eq "==");
            }
            if (!$repop && $value && $value =~ /[\*\?]/) {
                $repop = "matches";
                $sqlop = $sqlop{$repop};
            }

            if ($repop eq "verbatim") {
                push(@where, "$params->{$param}");
                next;
            }

            $column_def = $tabcols->{$column};

            if (!defined $column_def) {
                if ($param =~ /^begin_(.*)/) {
                    $column = $1;
                    $sqlop = ">=";
                    $inferred_op = 0;
                }
                elsif ($param =~ /^end_(.*)/) {
                    $column = $1;
                    $sqlop = "<=";
                    $inferred_op = 0;
                }
                $column_def = $tabcols->{$column};
            }

            next if (!defined $column_def);  # skip if the column is unknown

            if (! defined $value) {
                # $value = "?";   # TODO: make this work with the "contains/matches" operators
                if (!$sqlop || $sqlop eq "=") {
                    push(@where, "$column is null");
                }
                elsif ($sqlop eq "!=") {
                    push(@where, "$column is not null");
                }
            }
            else {
                next if ($inferred_op && $value eq "ALL");

                if (ref($value) eq "ARRAY") {
                    $value = join(",", @$value);
                }

                if ($value =~ s/^@\[(.*)\]$/$1/) {  # new @[] expressions replace !expr!
                    $quoted = 0;
                }
                elsif ($value =~ s/^@\{(.*)\}$/$1/) {  # replaced !expr!, but @{x} is interp'd by perl so deprecate!
                    $quoted = 0;
                }
                elsif ($value =~ s/^!expr!//) { # deprecated (ugh!)
                    $quoted = 0;
                }
                elsif ($value =~ /,/ && ! $tabledef->{param}{$param}{no_auto_in_param}) {
                    $quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted}) : ($value !~ /^-?[0-9.,]+$/);
                }
                else {
                    $quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted}) : ($value !~ /^-?[0-9.]+$/);
                }

                next if ($inferred_op && !$quoted && $value eq "");

                $include_null = 0;

                if ($repop eq "contains" || $repop eq "not_contains") {
                    $value = $dbh->quote("%" . $value . "%");
                }
                elsif ($repop eq "matches" || $repop eq "not_matches") {
                    $value = $dbh->quote($value);
                    $value =~ s/_/\\_/g;
                    $value =~ s/\*/%/g;
                    $value =~ s/\?/_/g;
                }
                elsif ($sqlop eq "in" || ($inferred_op && $sqlop eq "=")) {
                    if (! defined $value || $value eq "NULL") {
                        $sqlop = "is";
                        $value = "null";
                    }
                    else {
                        if ($value =~ s/NULL,//g || $value =~ s/,NULL//) {
                            $include_null = 1;
                        }
                        if ($quoted) {
                            $value = $dbh->quote($value);
                            if ($value =~ /,/ && ! $tabledef->{param}{$param}{no_auto_in_param}) {
                                $value =~ s/,/','/g;
                                $value = "($value)";
                                $sqlop = "in";
                            }
                            else {
                                $sqlop = "=";
                            }
                        }
                        else {
                            if ($value =~ /,/ && ! $tabledef->{param}{$param}{no_auto_in_param}) {
                                $value = "($value)";
                                $sqlop = "in";
                            }
                            else {
                                $sqlop = "=";
                            }
                        }
                    }
                }
                elsif ($sqlop eq "not in" || ($inferred_op && $sqlop eq "!=")) {
                    if (! defined $value || $value eq "NULL") {
                        $sqlop = "is not";
                        $value = "null";
                    }
                    else {
                        if ($value =~ s/NULL,//g || $value =~ s/,NULL//) {
                            $include_null = 1;
                        }
                        if ($quoted) {
                            $value = $dbh->quote($value);
                            if ($value =~ /,/ && ! $tabledef->{param}{$param}{no_auto_in_param}) {
                                $value =~ s/,/','/g;
                                $value = "($value)";
                                $sqlop = "not in";
                            }
                            else {
                                $sqlop = "!=";
                            }
                        }
                        else {
                            if ($value =~ /,/ && ! $tabledef->{param}{$param}{no_auto_in_param}) {
                                $value = "($value)";
                                $sqlop = "not in";

lib/App/Repository/DBI.pm  view on Meta::CPAN

    # create order-by columns
    ############################################################
    my (@order_by_dbexpr, $order_by_dbexpr);
    if (defined $order_by && ref($order_by) eq "ARRAY") {
        my ($dir);

        for ($idx = 0; $idx <= $#$order_by; $idx++) {
            $column = $order_by->[$idx];
            $dir = "";
            if ($column =~ /^(.+)\.asc$/) {
                $column = $1;
                $dir = " asc";
            }
            elsif ($column =~ /^(.+)\.desc$/) {
                $column = $1;
                $dir = " desc";
            }
            $column_def = $table_def->{column}{$column};
            next if (!defined $column_def);

            $order_by_dbexpr = $dbexpr{$column};
            if (!$order_by_dbexpr) {
                $order_by_dbexpr = $column_def->{dbexpr};
                $dbexpr{$column} = $order_by_dbexpr;
                $self->_require_tables($order_by_dbexpr, \%reqd_tables, $tablealiashref, 1);
            }

            $columnalias = $column_def->{alias};
            if (defined $columnidx{$column} && $columnalias) {
                $order_by_dbexpr = $columnalias;
            }

            if ($order_by_dbexpr) {
                if ($dir) {
                    $order_by_dbexpr .= $dir;
                }
                else {
                    if ($direction && ref($direction) eq "HASH" && defined $direction->{$column}) {
                        if ($direction->{$column} =~ /^[au]/i) {
                            $order_by_dbexpr .= " asc";
                        }
                        elsif ($direction->{$column} =~ /^d/i) {
                            $order_by_dbexpr .= " desc";
                        }
                    }
                }
                push(@order_by_dbexpr, $order_by_dbexpr);
            }
        }
    }

    ############################################################
    # create initial where conditions for the selected rows
    ############################################################

    #print $App::DEBUG_FILE $self->{context}->dump(), "\n";

    my %sqlop = (
        "contains"     => "like",
        "matches"      => "like",
        "not_contains" => "not like",
        "not_matches"  => "not like",
        "eq"           => "=",
        "ne"           => "!=",
        "le"           => "<=",
        "lt"           => "<",
        "ge"           => ">=",
        "gt"           => ">",
        "in"           => "in",
        "not_in"       => "not in",
    );
    my %repop = (
        "=~" => "contains",
        "~"  => "contains",
        "!~" => "not_contains",
        "==" => "eq",
        "="  => "eq",
        "!"  => "ne",
        "!=" => "ne",
        "<=" => "le",
        "<"  => "lt",
        ">=" => "ge",
        ">"  => "gt",
    );

    my ($include_null, $inferred_op);
    for ($idx = 0; $idx <= $#$param_order; $idx++) {

        $param = $param_order->[$idx];
        next if (!defined $param || $param eq "");

        $column = $param;

        #if ($param eq "_key") {
        #    # o TODO: enable multi-field primary keys (this assumes one-field only)
        #    # o TODO: enable non-integer primary key fields (this assumes integer, no quotes)
        #    $column = $table_def->{primary_key};  # assumes one column primary key
        #    $dbexpr = $table_def->{column}{$column}{dbexpr};
        #    if ($value =~ /,/) {
        #        $where_condition = "$dbexpr in ($value)";  # assumes one column, non-quoted primary key
        #    }
        #    else {
        #        $where_condition = "$dbexpr = $value";     # assumes one column, non-quoted primary key
        #    }
        #    push(@criteria_conditions, $where_condition);
        #    next;
        #}

        $sqlop = "=";
        $repop = "";
        $inferred_op = 1;
        $value = $params->{$param};
        # check if $param contains an embedded operation, i.e. "name.eq", "name.contains"
        if ($param =~ /^(.*)\.([^.]+)$/) {
            $repop = $2;
            $inferred_op = 0;
            if ($sqlop{$repop}) {
                $column = $1;
                $sqlop = $sqlop{$repop};
            }
        }
        if (!$repop && $value && $value =~ s/^(=~|~|!~|==|=|!=|!|<=|<|>=|>)//) {
            $repop = $repop{$1};
            $sqlop = $sqlop{$repop};
            $inferred_op = 0 if ($1 eq "==");
        }
        if (!$repop && $value && $value =~ /[\*\?]/) {
            $repop = "matches";
            $sqlop = $sqlop{$repop};
        }

        if ($repop eq "verbatim") {
            push(@criteria_conditions, $params->{$param});
            next;
        }

lib/App/Repository/DBI.pm  view on Meta::CPAN

        $column_def = $table_def->{column}{$column};

        if (!defined $column_def) {
            if ($param =~ /^begin_(.*)/) {
                $column = $1;
                $sqlop = ">=";
                $inferred_op = 0;
            }
            elsif ($param =~ /^end_(.*)/) {
                $column = $1;
                $sqlop = "<=";
                $inferred_op = 0;
            }
            $column_def = $table_def->{column}{$column};
        }

        if (defined $column_def) {  # skip if the column is unknown
            $include_null = 0;

            if (! defined $value) {
                # $value = "?";   # TODO: make this work with the "contains/matches" operators
                if (!$sqlop || $sqlop eq "=") {
                    $sqlop = "is";
                }
                elsif ($sqlop eq "!=") {
                    $sqlop = "is not";
                }
                else {
                    next;
                }
                $value = "null";
            }
            else {
                next if (defined $table_def->{param}{$param}{all_value} &&
                         $value eq $table_def->{param}{$param}{all_value});

                next if ($inferred_op && $value eq "ALL");

                if (ref($value) eq "ARRAY") {
                    $value = join(",", @$value);
                }

                if ($value =~ s/^@\[(.*)\]$/$1/) {  # new @[] expressions replace !expr!
                    $quoted = 0;
                }
                elsif ($value =~ s/^@\{(.*)\}$/$1/) {  # new @{} don't work.. perl interpolates... deprecate.
                    $quoted = 0;
                }
                elsif ($value =~ s/^!expr!//) { # deprecated (ugh!)
                    $quoted = 0;
                }
                elsif ($value =~ /,/ && ! $table_def->{param}{$param}{no_auto_in_param}) {
                    $quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted}) : ($value !~ /^-?[0-9.,]+$/);
                }
                else {
                    $quoted = (defined $column_def->{quoted}) ? ($column_def->{quoted}) : ($value !~ /^-?[0-9.]+$/);
                }

                next if ($inferred_op && !$quoted && $value eq "");

                if ($repop eq "contains" || $repop eq "not_contains") {
                    $value = $dbh->quote("%" . $value . "%");
                }
                elsif ($repop eq "matches" || $repop eq "not_matches") {
                    $value = $dbh->quote($value);
                    $value =~ s/_/\\_/g;
                    $value =~ s/\*/%/g;
                    $value =~ s/\?/_/g;
                }
                elsif ($sqlop eq "in" || ($inferred_op && $sqlop eq "=")) {

                    if (! defined $value || $value eq "NULL") {
                        $sqlop = "is";
                        $value = "null";
                    }
                    else {
                        if ($value =~ s/NULL,//g || $value =~ s/,NULL//) {
                            $include_null = 1;
                        }
                        if ($quoted) {
                            $value = $dbh->quote($value);
                            if ($value =~ /,/ && ! $table_def->{param}{$param}{no_auto_in_param}) {
                                $value =~ s/,/','/g;
                                $value = "($value)";
                                $sqlop = "in";
                            }
                            else {
                                $sqlop = "=";
                            }
                        }
                        else {
                            if ($value =~ /,/ && ! $table_def->{param}{$param}{no_auto_in_param}) {
                                $value = "($value)";
                                $sqlop = "in";
                            }
                            else {
                                $sqlop = "=";
                            }
                        }
                    }
                }
                elsif ($sqlop eq "not in" || ($inferred_op && $sqlop eq "!=")) {

                    if (! defined $value || $value eq "NULL") {
                        $sqlop = "is not";
                        $value = "null";
                    }
                    else {
                        if ($value =~ s/NULL,//g || $value =~ s/,NULL//) {
                            $include_null = 1;
                        }
                        if ($quoted) {
                            $value = $dbh->quote($value);
                            if ($value =~ /,/ && ! $table_def->{param}{$param}{no_auto_in_param}) {
                                $value =~ s/,/','/g;
                                $value = "($value)";
                                $sqlop = "not in";
                            }
                            else {
                                $sqlop = "!=";
                            }
                        }
                        else {
                            if ($value =~ /,/ && ! $table_def->{param}{$param}{no_auto_in_param}) {