view release on metacpan or search on metacpan
lib/CGI/OptimalQuery/XML.pm
lib/DBIx/OptimalQuery.pm
LICENSE
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
README
t/001_load.t
t/002_simpleusage.t
t/003_likefilter.t
t/004_newcursor.t
t/005_notcontainsmultival.t
t/006_noEscapeColMultival.t
t/007_notequalmultival.t
t/008_filterchecks.t
t/testutil.pl
Todo
unittestsetup.sh.sample
WHERE_SQL (undef | STRING | ARRAYREF)
This is deprecated. It was used to describe the SQL in the where
clause that was needed to join the table described in the from
clause. Since SQL-92 allows developers to put the join SQL in the
join, this should not be used.
OPTIONS (undef | HASHREF)
The following KEY/VALUES below describe OPTIONS used by the joins
configuration.
new_cursor => 1
tells OptimalQuery to open a new cursor for this join. This
can be used to select and filter multi-value fields.
Optionally, an order_by param can be specified to sort the
results returned by the cursor as such:
new_cursor_order_by => "some_field.id"
*OPTIONAL CONFIGURATION*
The following KEY/VALUES below for %CONFIG in the call to "new" are
NOT required.
AutoSetLongReadLen => 1
Tells OptimalQuery to automatically set "$dbh->{SetLongReadLen}". Used
only in Oracle. Enabling this setting may slow down OptimalQuery since
it needs to do extra queries to set the length if LOBS exist. This is
only enabled by default when using Oracle.
demo/cgi-bin/product.pl view on Meta::CPAN
'NAME' => ['product', 'product.name', 'Name'],
'PRODNO' => ['product', 'product.prodno', 'Product No.'],
'BARCODES' => ['inventory', 'inventory.barcode', 'Barcodes'],
'MANUFACT' => ['manufact', 'manufact.name', 'Manufacturer']
},
'show' => "NAME,MANUFACT",
'joins' => {
'product' => [undef, 'product'],
'manufact' => ['product', 'LEFT JOIN manufact ON (product.manufact=manufact.id)'],
'inventory' => ['product', 'LEFT JOIN inventory ON (product.id=inventory.product)', undef,
{ new_cursor => 1, new_cursor_order_by => "inventory.barcode DESC" }]
},
'options' => {
'CGI::OptimalQuery::InteractiveQuery' => {
'editLink' => 'record.pl'
}
}
);
CGI::OptimalQuery->new(\%schema)->output();
lib/CGI/OptimalQuery.pm view on Meta::CPAN
The following KEY/VALUES below describe OPTIONS used by the joins configuration.
=over
=item B<< always_join => 1 >>
tells OptimalQuery to always include join in query. Usfual when the join itself influences the number of results returned. Alternatively, an inline view could be constructed that performs the joins as part of the driving data set.
=item B<< new_cursor => 1 >>
tells OptimalQuery to open a new cursor for this join. This can be used to select and filter multi-value fields.
Optionally, an order_by param can be specified to sort the results returned by the cursor as such:
=item B<< new_cursor_order_by => "some_field.id" >>
=back
=back
=item I<< OPTIONAL CONFIGURATION >>
The following KEY/VALUES below for C<< %CONFIG >> in the call to C<new> are NOT required.
lib/CGI/OptimalQuery/Base.pm view on Meta::CPAN
# multi valued selects (since it never makes since to sort a m-valued column)
my %cached_dep_multival_status;
my $find_dep_multival_status_i;
my $find_dep_multival_status;
$find_dep_multival_status = sub {
my $joinAlias = shift;
$find_dep_multival_status_i++;
die "could not resolve join alias: $joinAlias deps" if $find_dep_multival_status_i > 100;
if (! exists $cached_dep_multival_status{$joinAlias}) {
my $v;
if (exists $$o{oq}{joins}{$joinAlias}[3]{new_cursor}) { $v = 0; }
elsif (! @{ $$o{oq}{joins}{$joinAlias}[0] }) { $v = 1; }
else { $v = $find_dep_multival_status->($$o{oq}{joins}{$joinAlias}[0][0]); }
$cached_dep_multival_status{$joinAlias} = $v;
}
return $cached_dep_multival_status{$joinAlias};
};
# loop though all selects
foreach my $selectAlias (keys %{ $$o{oq}{select} }) {
$find_dep_multival_status_i = 0;
lib/CGI/OptimalQuery/InteractiveQuery.pm view on Meta::CPAN
#OQhead {
background-color: #666666;
}
#OQhead td {
color: white;
padding: 0px;
}
#OQdoc button {
cursor: pointer;
background-color: #dddddd;
border: 1px outset #333333;
font-size: .8em;
color: #111111;
padding: 0px;
}
#OQsummary {
width: 30%
}
lib/CGI/OptimalQuery/InteractiveQuery.pm view on Meta::CPAN
position: absolute;
right: 0;
color: black;
font-weight: bold;
padding: 0px;
margin: 0px;
background-color: white;
border: 1px outset black;
text-align: center;
vertical-align: middle;
cursor: pointer;
font-size: .8em;
}
#cmdOptions h1 {
color: #222222;
margin: 0px;
font-size: 1.2em;
padding: 0;
}
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
#OQbody {
margin: 0;
font-family: Sans-serif;
margin-bottom: 6em;
}
form.OQform a,
form.OQform button {
cursor: pointer;
}
form.OQform input:focus, form.OQform select:focus {
background-color: #ffd;
}
form.OQform {
position: relative;
margin: 0;
}
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
background-color: #ffd;
}
.OQinfo td.OQlabel {
width: 3em;
text-align: center;
padding-left: 0;
background-color: #ccc;
border: 1px solid #bbb;
}
.OQFilterDescr {
cursor: pointer;
}
.OQRecUpdateMsg {
background-color: #fdd;
text-align: center;
padding: 2px;
color: #222;
border: 1px solid #ffe;
font-weight: bold;
}
.OQBlocker {
position: absolute;
top: 0; left: 0; right: 0; bottom: 0;
width: 100%;
height: 100%;
cursor: wait;
display: none;
}
.OQAddColumnsPanel, .OQFilterPanel, .OQHelpPanel {
display: none;
position: absolute;
top: 80px;
left: 10px;
right: 10px;
background-color: #fff;
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
.OQemailmergetemplatevars {
padding: 6px;
border: 1px solid #aaa;
background-color: #fff;
margin-top: 4px;
margin-top: 4px;
border-radius: 2px;
}
.OQemailmergetemplatevars .OQTemplateVar {
cursor: pointer;
font-size: .9em;
padding: 6px;
}
.OQemailmergemsgs {
max-height: 30em;
overflow: auto;
}
.OQemailmergeview > * {
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
position: relative;
margin: 0;
padding: 0;
}
.OQToolExpander:hover h3 {
background-color: #ffd;
}
.OQToolExpander h3 {
margin: 0;
padding: 10px;
cursor: pointer;
}
.AutoActionSummaryElem {
border-top: 1px solid #ccc;
clear: both;
}
.AutoActionSummaryElem:first-child {
border-top: 0;
}
.OQRemoveAutoActionBut {
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
.OQAddColumnsPanel button {
font-size: 1.6em;
margin: .5em;
}
.OQAddColumnsPanel label {
min-width: 160px;
font-weight: normal;
font-size: 12px;
padding: 4px;
display: inline-block;
cursor: pointer;
}
.CancelFilterBut, .OKFilterBut {
font-size: 1.6em;
margin: .5em;
}
.OQFilterPanel table button.lp,
.OQFilterPanel table button.rp {
color: #ccc;
border: 0;
background-color: transparent;
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
}
table.OQdata td.num,
table.OQdata td.date {
text-align: right;
}
table.OQdata > thead td {
text-align: center;
background-color: #ddd;
font-size: .8em;
cursor: pointer;
border: 1px solid #aaa;
border-width: 0 1px 1px 1px;
height: 3em;
font-weight: bold;
}
table.OQdata > thead td:hover {
background-color: #ffd;
}
table.OQdata > thead td[data-noselect][data-nosort][data-nosort] {
background-color: #ddd;
cursor: default;
}
table.OQdata > thead td:first-child,
table.OQdata > thead td:last-child {
background-color: #ddd;
width: 1%;
}
table.OQdata > tbody tr.OQupdatedRow td,
table.OQdata > tbody tr.OQupdatedRow {
background-color: #fdd;
}
.OQColumnCmdPanel {
position: absolute;
width: 140px;
top: 0;
left: 0;
display: none;
border: 1px solid #666;
background-color: #fff;
cursor: pointer;
}
.OQColumnCmdPanel button {
padding: 10px;
padding-left: 34px;
color: black;
font-size: .9em;
margin: 0;
border: 0;
border-bottom: 1px solid #ddd;
background-color: transparent;
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
.OQColumnCmdPanel button:hover {
background-color: #ffd;
}
.OQform button[disabled] {
color: #888;
text-shadow: 2px 2px 5px #ccc;
}
.OQColumnCmdPanel button[disabled]:hover {
background-color: transparent;
cursor: default;
}
a.OQeditBut, a.OQnewBut {
display: inline-block;
}
.OQcmds > button,
.OQRecViewCmds > button,
.OQeditBut {
font-size: 0 !important;
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
.OQStatsBut {
background-image: url(view-statistics.png);
}
.OQToolsCancelBut {
position:absolute;
right:4px;
top:4px;
font-size:20px;
font-weight:bold;
color:#858585;
cursor:pointer;
height:30px;
width:30px;
font-family:serif;
border: 1px solid #ddd;
border-radius: 6px;
background-color: #eee;
padding: 0;
text-align: center;
}
.OQToolsCancelBut:hover {
lib/CGI/OptimalQuery/Resources/InteractiveQuery2.css view on Meta::CPAN
}
.OQAddColumnsPanel {
padding: 15px;
}
.OQAddColumnsPanel .ckbox {
font-size: 11px;
min-width: 14em;
display: inline-block;
margin: 4px;
padding: 6px;
cursor: pointer;
border-radius: 6px;
text-align: left;
}
label.ckbox:hover {
background-color: #ffd;
}
.OQAddColumnsPanel .ckbox > * {
vertical-align: middle;
}
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
sub get_lo_rec { $_[0]{limit}[0] }
sub get_hi_rec { $_[0]{limit}[1] }
sub set_limit {
my ($sth, $limit) = @_;
$$sth{limit} = $limit;
return undef;
}
# execute statement
# notice that we can't execute other child cursors
# because their bind params are dependant on
# their parent cursor value
sub execute {
my ($sth) = @_;
return undef if $$sth{_already_executed};
$$sth{_already_executed}=1;
#$$sth{oq}{error_handler}->("DEBUG: \$sth->execute()\n") if $$sth{oq}{debug};
return undef if $sth->count()==0;
local $$sth{oq}{dbh}{LongReadLen};
# build SQL for main cursor
{ my $c = $sth->{cursors}->[0];
my @all_deps = (@{$c->{select_deps}}, @{$c->{where_deps}}, @{$c->{order_by_deps}});
my ($order) = $sth->{oq}->_order_deps(@all_deps);
my @from_deps; push @from_deps, @$_ for @$order;
# create from_sql, from_binds
# vars prefixed with old_ is used for supported non sql-92 joins
my ($from_sql, @from_binds, $old_join_sql, @old_join_binds );
foreach my $from_dep (@from_deps) {
my ($sql, @binds) = @{ $sth->{oq}->{joins}->{$from_dep}->[1] };
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
if (! $$sth{oq}{dbh}{LongReadLen} || $SetLongReadLen > $$sth{oq}{dbh}{LongReadLen}) {
$$sth{oq}{dbh}{LongReadLen} = $SetLongReadLen;
}
}
$sth->add_limit_sql();
}
# build children cursors
my $cursors = $sth->{cursors};
foreach my $i (1 .. $#$cursors) {
my $c = $sth->{cursors}->[$i];
my $sd = $c->{select_deps};
# define sql and binds for joins for this child cursor
# in the following vars
my ($from_sql, @from_binds, $where_sql, @where_binds );
# define vars for child cursor driving table
# these are handled differently since we aren't joining in parent deps
# they were precomputed in _normalize method when constructing $oq
($from_sql, @from_binds) =
@{ $sth->{oq}->{joins}->{$sd->[0]}->[3]->{new_cursor}->{sql} };
$where_sql = $sth->{oq}->{joins}->{$sd->[0]}->[3]->{new_cursor}->{'join'};
my $order_by_sql = '';
if ($sth->{oq}->{joins}->{$sd->[0]}->[3]->{new_cursor_order_by}) {
$order_by_sql = " ORDER BY ".$sth->{oq}->{joins}->{$sd->[0]}->[3]->{new_cursor_order_by};
}
$from_sql .= "\n";
# now join in all other deps normally for this cursor
foreach my $i (1 .. $#$sd) {
my $joinAlias = $sd->[$i];
my ($sql, @binds) = @{ $sth->{oq}->{joins}->{$joinAlias}->[1] };
# these will NOT be defined for sql-92 type joins
my ($joinWhereSql, @joinWhereBinds) =
@{ $sth->{oq}->{joins}->{$joinAlias}->[2] }
if defined $sth->{oq}->{joins}->{$joinAlias}->[2];
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
$from_sql .= ",\n$sql $joinAlias";
push @from_binds, @binds;
if ($joinWhereSql) {
$where_sql .= " AND " if $where_sql;
$where_sql .= $joinWhereSql;
}
push @where_binds, @joinWhereBinds;
}
}
# build child cursor sql
$c->{sql} = "
SELECT ".join(',', @{ $c->{select_sql} })."
FROM $from_sql
WHERE $where_sql
$order_by_sql ";
$c->{binds} = [ @{ $c->{select_binds} }, @from_binds, @where_binds ];
# if clobs have been selected, find & set LongReadLen
if ($$sth{oq}{dbtype} eq 'Oracle' &&
$$sth{'oq'}{'AutoSetLongReadLen'} &&
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
FROM (".$$c{'sql'}.")", undef, @{$$c{'binds'}});
if (! $$sth{oq}{dbh}{LongReadLen} || $SetLongReadLen > $$sth{oq}{dbh}{LongReadLen}) {
$$sth{oq}{dbh}{LongReadLen} = $SetLongReadLen;
}
}
}
eval {
my $c;
# prepare all cursors
foreach $c (@$cursors) {
$$sth{oq}->{error_handler}->("SQL:\n".$c->{sql}."\nBINDS:\n".Dumper($c->{binds})."\n") if $$sth{oq}{debug};
$c->{sth} = $sth->{oq}->{dbh}->prepare($c->{sql});
}
$c = $$cursors[0];
$c->{sth}->execute( @{ $c->{binds} } );
my @fieldnames = @{ $$c{select_field_order} };
my %rec;
my @bindcols = \( @rec{ @fieldnames } );
$c->{sth}->bind_columns(@bindcols);
$c->{bind_hash} = \%rec;
};
if ($@) {
die "Problem with SQL; $@\n";
}
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
}
# function to add limit sql
# $sth->add_limit_sql()
sub add_limit_sql {
my ($sth) = @_;
#$$sth{oq}{error_handler}->("DEBUG: \$sth->add_limit_sql()\n") if $$sth{oq}{debug};
my $lo_limit = $$sth{limit}[0] || 0;
my $hi_limit = $$sth{limit}[1] || $sth->count();
my $c = $sth->{cursors}->[0];
if ($$sth{oq}{dbtype} eq 'Oracle') {
$c->{sql} = "
SELECT *
FROM (
SELECT tablernk1.*, rownum RANK
FROM (
".$c->{sql}."
) tablernk1
WHERE rownum <= ?
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
push @select, $select;
}
$sth->{show} = \@select;
}
# define filter & sort if not defined
$sth->{'filter'} = "" if ! exists $sth->{'filter'};
$sth->{'sort'} = "" if ! exists $sth->{'sort'};
$sth->{'fetch_index'} = 0;
$sth->{'count'} = undef;
$sth->{'cursors'} = undef;
return undef;
}
# define @select & @select_binds, and add deps
sub create_select {
my $sth = shift;
#$$sth{oq}{error_handler}->("DEBUG: \$sth->create_select()\n") if $$sth{oq}{debug};
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
# add deps used in always_select
foreach my $colAlias (keys %{ $sth->{'oq'}->{'select'} }) {
if ($sth->{'oq'}->{'select'}->{$colAlias}->[3]->{always_select} ) {
$show{$colAlias} = 1;
$deps{$_} = 1 for @{ $sth->{'oq'}->{'select'}->{$colAlias}->[0] };
}
}
@deps = keys %deps;
}
# order and index deps into appropriate cursors
my ($dep_order, $dep_idx) = $sth->{oq}->_order_deps(@deps);
# look though select again and add all cols with is_hidden option
# if all their deps have been fulfilled
foreach my $colAlias (keys %{ $sth->{'oq'}->{'select'} }) {
if ($sth->{'oq'}->{'select'}->{$colAlias}->[3]->{is_hidden}) {
my $deps = $sth->{'oq'}->{'select'}->{$colAlias}->[0];
my $all_deps_met = 1;
for (@$deps) {
if (! exists $dep_idx->{$_}) {
$all_deps_met = 0;
last;
}
}
$show{$colAlias} = 1 if $all_deps_met;
}
}
# create main cursor structure & attach deps for main cursor
$sth->{'cursors'} = [ $sth->_get_main_cursor_template() ];
$sth->{'cursors'}->[0]->{'select_deps'} = $dep_order->[0];
# unique counter that is used to uniquely identify cols in parent cursors
# to their children cursors
my $parent_bind_tag_idx = 0;
# create other cursors (if they exist)
# and define how they join to their parent cursors
# by defining parent_join, parent_keys
foreach my $i (1 .. $#$dep_order) {
push @{ $sth->{'cursors'} }, $sth->_get_sub_cursor_template();
$sth->{'cursors'}->[$i]->{'select_deps'} = $dep_order->[$i];
# add parent_join, parent_keys for this child cursor
my $driving_child_join_alias = $dep_order->[$i]->[0];
my $cursor_opts = $sth->{'oq'}->{'joins'}->{$driving_child_join_alias}->[3]->{new_cursor};
foreach my $part (@{ $cursor_opts->{'keys'} } ) {
my ($dep,$sql) = @$part;
my $key = 'DBIXOQMJK'.$parent_bind_tag_idx; $parent_bind_tag_idx++;
my $parent_cursor_idx = $dep_idx->{$dep};
die "could not find dep: $dep for new cursor" if $parent_cursor_idx eq '';
push @{ $sth->{'cursors'}->[$parent_cursor_idx]->{select_field_order} }, $key;
push @{ $sth->{'cursors'}->[$parent_cursor_idx]->{select_sql} }, "$dep.$sql AS $key";
push @{ $sth->{'cursors'}->[$i]->{'parent_keys'} }, $key;
}
$sth->{'cursors'}->[$i]->{'parent_join'} = $cursor_opts->{'join'};
}
# plug in select_sql, select_binds for cursors
foreach my $show (keys %show) {
my $select = $sth->{'oq'}->{'select'}->{$show};
next if ! $select;
my $cursor = $sth->{'cursors'}->[$dep_idx->{$select->[0]->[0]}];
my $select_sql;
# if type is date then use specified date format
if (! $$select[3]{select_sql} && $$select[3]{date_format}) {
my @tmp = @{ $select->[1] }; $select_sql = \ @tmp; # need a real copy cause we are going to mutate it
if ($$sth{oq}{dbtype} eq 'Oracle' ||
$$sth{oq}{dbtype} eq 'Pg') {
$$select_sql[0] = "to_char(".$$select_sql[0].",'".$$select[3]{date_format}."')";
} elsif ($$sth{oq}{dbtype} eq 'mysql') {
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
}
# else just copy the select
else {
$select_sql = $select->[3]->{select_sql} || $select->[1];
}
# remember if a lob is selected
if ($$sth{oq}{dbtype} eq 'Oracle' &&
$sth->{oq}->get_col_types('select')->{$show} eq 'clob') {
push @{ $cursor->{selected_lobs} }, $show;
#$select_sql->[0] = 'to_char('.$select_sql->[0].')';
}
if ($select_sql->[0] ne '') {
push @{ $cursor->{select_field_order} }, $show;
push @{ $cursor->{select_sql} }, $select_sql->[0].' AS '.$show;
push @{ $cursor->{select_binds} }, @$select_sql[1 .. $#$select_sql];
}
}
return undef;
}
# template for the main cursor
sub _get_main_cursor_template {
{ sth => undef,
sql => "",
binds => [],
selected_lobs => [],
select_field_order => [],
select_sql => [],
select_binds => [],
select_deps => [],
where_sql => "",
where_binds => [],
where_deps => [],
where_name => "",
order_by_sql => "",
order_by_binds => [],
order_by_deps => [],
order_by_name => []
};
}
# template for explicitly defined additional cursors
sub _get_sub_cursor_template {
{ sth => undef,
sql => "",
binds => [],
selected_lobs => [],
select_field_order => [],
select_sql => [],
select_deps => [],
select_binds => [],
parent_join => "",
parent_keys => [],
};
}
# modify cursor and add where clause data
sub create_where {
my ($sth) = @_;
# define cursor where_sql, where_deps, where_name where_binds from parsed filter types
my $c = $sth->{cursors}->[0];
foreach my $filterType (qw( filter hiddenFilter forceFilter)) {
next if $$sth{$filterType} eq '';
my $filterArray = $$sth{oq}->parseFilter($$sth{$filterType});
my $filterSQL = $$sth{oq}->generateFilterSQL($filterArray);
push @{ $$c{where_deps} }, @{ $$filterSQL{deps} };
if ($$c{where_sql}) {
$$c{where_sql} .= ' AND ('.$$filterSQL{sql}.')';
} else {
$$c{where_sql} = $$filterSQL{sql};
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
push @{ $$c{where_binds} }, @{ $$filterSQL{binds} };
$$c{where_name} = $$filterSQL{name} if $filterType eq 'filter';
}
return undef;
}
# modify cursor and add order by data
sub create_order_by {
my ($sth) = @_;
my $c = $sth->{cursors}->[0];
my $s = $$sth{oq}->parseSort($$sth{'sort'});
$$c{order_by_deps} = $$s{deps};
$$c{order_by_sql} = join(',', @{ $$s{sql} });
$$c{order_by_binds} = $$s{binds};
$$c{order_by_name} = $$s{name};
return undef;
}
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
# fetch next row or return undef when done
sub fetchrow_hashref {
my ($sth) = @_;
return undef unless $sth->count() > 0;
$sth->execute(); # execute if not already existed
#$$sth{oq}{error_handler}->("DEBUG: \$sth->fetchrow_hashref()\n") if $$sth{oq}{debug};
my $cursors = $sth->{cursors};
my $c = $cursors->[0];
# bind hash value to column data
my $rec = $$c{bind_hash};
# fetch record
if (my $v = $c->{sth}->fetch()) {
foreach my $i (0 .. $#$v) {
# if col type is decimal auto trim 0s after decimal
if ($c->{sth}->{TYPE}->[$i] eq '3' && $$v[$i] =~ /\./) {
$$v[$i] =~ s/0+$//;
$$v[$i] =~ s/\.$//;
}
}
$sth->{'fetch_index'}++;
# execute other cursors
foreach my $i (1 .. $#$cursors) {
$c = $cursors->[$i];
$c->{sth}->execute( @{ $c->{binds} },
map { $$rec{$_} } @{ $c->{parent_keys} } );
my $cols = $$c{select_field_order};
@$rec{ @$cols } = [];
while (my @vals = $c->{sth}->fetchrow_array()) {
for (my $i=0; $i <= $#$cols; $i++) {
push @{ $$rec{$$cols[$i]} }, $vals[$i];
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
return $rec;
} else {
return undef;
}
}
# finish sth
sub finish {
my ($sth) = @_;
#$$sth{oq}{error_handler}->("DEBUG: \$sth->finish()\n") if $$sth{oq}{debug};
foreach my $c (@{$$sth{cursors}}) {
$$c{sth}->finish() if $$c{sth};
undef $$c{sth};
}
return undef;
}
# get count for sth
sub count {
my $sth = shift;
# if count is not already defined, define it
if (! defined $sth->{count}) {
#$$sth{oq}{error_handler}->("DEBUG: \$sth->count()\n") if $$sth{oq}{debug};
my $c = $sth->{cursors}->[0];
my $drivingTable = $c->{select_deps}->[0];
# only need to join in driving table with
# deps used in where clause
my ($deps) = $sth->{oq}->_order_deps($drivingTable, @{$c->{where_deps}});
my @from_deps; push @from_deps, @$_ for @$deps;
# create from_sql, from_binds
# vars prefixed with old_ is used for supported non sql-92 joins
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
}
}
return $sth->{count};
}
sub fetch_index { $_->{'fetch_index'} }
sub filter_descr {
my $sth = shift;
return $sth->{cursors}->[0]->{'where_name'};
}
sub sort_descr {
my $sth = shift;
if (wantarray) {
return @{ $sth->{cursors}->[0]->{'order_by_name'} };
} else {
return join(', ', @{ $sth->{cursors}->[0]->{'order_by_name'} });
}
}
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
} else {
$leftSql = "TO_CHAR($leftSql,'$$leftOpts{date_format}')";
}
}
$rightSql = '?';
push @rightBinds, $rval;
}
}
# if the leftSql uses a new cursor we need to write an exists expression
# search dep path to see if a new_cursor is used
my @path = ($$leftDeps[0]);
my $i=0;
while (1) {
die "infinite dep loop detected" if ++$i==50;
my $parentDep = $$oq{joins}{$path[-1]}[0][0];
last unless $parentDep;
push @path, $parentDep;
}
# find the oldest parent new cursor if it exists
while (@path) {
if ($$oq{joins}{$path[-1]}[3]{new_cursor}) {
last;
} else {
pop @path;
}
}
# if @path has elements, this uses a new_cursor and we must construct an exists expression
if (@path) {
@path = reverse @path;
my ($preSql, $postSql, @preBinds);
foreach my $joinDep (@path) {
my ($fromSql, @fromBinds) = @{ $$oq{joins}{$joinDep}[1] };
# unwrap SQL-92 join and add join to where
$fromSql =~ s/^\s+//;
$fromSql =~ s/^LEFT\s*//i;
$fromSql =~ s/^OUTER\s*//i;
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
if exists $opts->{$opt} && ref($opts->{$opt}) ne 'ARRAY';
}
# make sure defined deps exist
foreach my $dep (@{ $$oq{'select'}{$col}[0] }) {
die "dep $dep for select $col does not exist"
if defined $dep && ! exists $$oq{'joins'}{$dep};
}
}
# look for new cursors and define parent child links if not already defined
foreach my $join (keys %{ $oq->{'joins'} }) {
my $opts = $oq->{'joins'}->{$join}->[3];
if (exists $opts->{new_cursor}) {
if (ref($opts->{new_cursor}) ne 'HASH') {
$oq->_formulate_new_cursor($join);
} else {
die "could not find keys, join, and sql for new cursor in $join"
unless exists $opts->{new_cursor}->{'keys'} &&
exists $opts->{new_cursor}->{'join'} &&
exists $opts->{new_cursor}->{'sql'};
}
}
# make sure defined deps exist
foreach my $dep (@{ $$oq{'joins'}{$join}[0] }) {
die "dep $dep for join $join does not exist"
if defined $dep && ! exists $$oq{'joins'}{$dep};
}
}
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
return undef;
}
# defines how a child cursor joins to its parent cursor
# by defining keys, join, sql in child cursor
# called from the _normalize method
sub _formulate_new_cursor {
my $oq = shift;
my $joinAlias = shift;
#$$oq{error_handler}->("DEBUG: \$oq->_formulate_new_cursor('$joinAlias')\n") if $$oq{debug};
# vars to define
my (@keys, $join, $sql, @sqlBinds);
# get join definition
my ($fromSql, @fromBinds) = @{ $oq->{joins}->{$joinAlias}->[1] };
my ($whereSql, @whereBinds);
($whereSql, @whereBinds) = @{ $oq->{joins}->{$joinAlias}->[2] }
if defined $oq->{joins}->{$joinAlias}->[2];
# if NOT an SQL-92 type join
if (defined $whereSql) {
$whereSql =~ s/\(\+\)/\ /g; # remove outer join notation
die "BAD_PARAMS - where binds not allowed in 'new_cursor' joins"
if scalar(@whereBinds);
}
# else is SQL-92 so separate out joins from table definition
# do this by making it a pre SQL-92 type join
# by defining $whereSql
# and removing join sql from $fromSql
else {
$_ = $fromSql;
m/\G\s*left\b/sicg;
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
} else {
push @keys, [$dep, $sql];
$join .= '?';
}
} else {
$join .= $part;
}
}
# fill in options
$oq->{joins}->{$joinAlias}->[3]->{'new_cursor'} = {
'keys' => \@keys, 'join' => $join, 'sql' => [$sql, @sqlBinds] };
return undef;
}
# make sure the join counts are the same
# throws exception with error when there is a problem
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
sub check_join_counts {
my $oq = shift;
#$$oq{error_handler}->("DEBUG: \$oq->check_join_counts()\n") if $$oq{debug};
# since driving table count is computed first this will get set first
my $drivingTableCount;
foreach my $join (keys %{ $oq->{joins} }) {
my ($cursors) = $oq->_order_deps($join);
my @deps = map { @$_ } @$cursors; # flatten deps in cursors
my $drivingTable = $deps[0];
# now create from clause
my ($fromSql, @fromBinds, @whereSql, @whereBinds);
foreach my $joinAlias (@deps) {
my ($sql, @sqlBinds) = @{ $oq->{joins}->{$joinAlias}->[1] };
# if this is the driving table
if (! $oq->{joins}->{$joinAlias}->[0]) {
# alias it if not already aliased in sql
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
# prepare an sth
sub prepare {
my $oq = shift;
#$$oq{error_handler}->("DEBUG: \$oq->prepare(".Dumper(\@_).")\n") if $$oq{debug};
return DBIx::OptimalQuery::sth->new($oq,@_);
}
# returns ARRAYREF: [order,idx]
# order is [ [dep1,dep2,dep3], [dep4,dep5,dep6] ], # cursor/dep order
# idx is { dep1 => 0, dep4 => 1, .. etc .. } # index of what cursor dep is in
sub _order_deps {
my ($oq, @deps) = @_;
#$$oq{error_handler}->("DEBUG: \$oq->_order_deps(".Dumper(\@_).")\n") if $$oq{debug};
# add always_join deps
foreach my $joinAlias (keys %{ $$oq{joins} }) {
push @deps, $joinAlias if $$oq{joins}{$joinAlias}[3]{always_join};
}
# @order is an array of array refs. Where each array ref represents deps
# for a separate cursor
# %idx is a hash of scalars where the hash key is the dep name and the
# hash value is what index into order (which cursor number)
# where you find the dep
my (@order, %idx);
# var to detect infinite recursion
my $maxRecurse = 1000;
# recursive function to order deps
# each dep calls this again on all parent deps until all deps are fulfilled
# then the dep is added
# modfies @order & %idx
lib/DBIx/OptimalQuery.pm view on Meta::CPAN
if (defined $oq->{'joins'}->{$dep}->[0]) {
foreach my $parent_dep (@{ $oq->{'joins'}->{$dep}->[0] } ) {
$place_missing_deps->($parent_dep) if ! exists $idx{$parent_dep};
}
}
# at this point all parent deps have been added,
# now add this dep if it has not already been added
if (! exists $idx{$dep}) {
# add new cursor if dep is main driving table or has option new_cursor
if (! defined $oq->{'joins'}->{$dep}->[0] ||
exists $oq->{'joins'}->{$dep}->[3]->{new_cursor}) {
push @order, [$dep];
$idx{$dep} = $#order;
}
# place dep in @order & %idx
# uses the same cursor as its parent dep
# this is found by looking at the parent_idx
else {
my $parent_idx = $idx{$oq->{'joins'}->{$dep}->[0]->[0]} || 0;
push @{ $order[ $parent_idx ] }, $dep;
$idx{$dep} = $parent_idx;
}
}
return undef;
};
t/004_newcursor.t view on Meta::CPAN
my $oq = OQ::schema(
'select' => {
'U_ID' => ['movie','movie.movie_id','Movie ID'],
'NAME' => ['movie', 'movie.name', 'Name'],
'CAST' => ['moviecastperson', 'moviecastperson.name', 'All Cast (seprated by commas)']
},
filter => "[NAME] like 'Return of the Jedi'",
'module' => 'CSV',
'joins' => {
'movie' => [undef, "oqtest_movie movie"],
'moviecast' => ['movie', 'JOIN oqtest_moviecast moviecast ON (movie.movie_id = moviecast.movie_id)', undef, { new_cursor => 1 }],
'moviecastperson' => ['moviecast', 'JOIN oqtest_person moviecastperson ON (moviecast.person_id=moviecastperson.person_id)']
}
);
$oq->output();
$errs .= "$OQ::DBTYPE missing return cast" unless $OQ::BUF =~ /Harrison Ford\, Mark Hamill/s;
});
is($errs, '', 'newcursor test');
t/005_notcontainsmultival.t view on Meta::CPAN
my $oq = OQ::schema(
'select' => {
'U_ID' => ['movie','movie.movie_id','Movie ID'],
'NAME' => ['movie', 'movie.name', 'Name'],
'CAST' => ['moviecastperson', 'moviecastperson.name', 'All Cast (seprated by commas)']
},
filter => "[CAST] not contains 'Hamill'",
'module' => 'CSV',
'joins' => {
'movie' => [undef, "oqtest_movie movie"],
'moviecast' => ['movie', 'JOIN oqtest_moviecast moviecast ON (movie.movie_id = moviecast.movie_id)', undef, { new_cursor => 1 }],
'moviecastperson' => ['moviecast', 'JOIN oqtest_person moviecastperson ON (moviecast.person_id=moviecastperson.person_id)']
}
);
$oq->output();
$errs .= "$OQ::DBTYPE has Hamill; " if $OQ::BUF =~ /Hamill/s;
});
is($errs, '', "notcontainsmultival");
t/005_notcontainsmultival.t view on Meta::CPAN
my $oq = OQ::schema(
'select' => {
'U_ID' => ['movie','movie.movie_id','Movie ID'],
'NAME' => ['movie', 'movie.name', 'Name'],
'CAST' => ['moviecastperson', 'moviecastperson.name', 'All Cast (seprated by commas)']
},
filter => "[CAST] not contains ''",
'module' => 'CSV',
'joins' => {
'movie' => [undef, "oqtest_movie movie"],
'moviecast' => ['movie', 'JOIN oqtest_moviecast moviecast ON (movie.movie_id = moviecast.movie_id)', undef, { new_cursor => 1 }],
'moviecastperson' => ['moviecast', 'JOIN oqtest_person moviecastperson ON (moviecast.person_id=moviecastperson.person_id)']
}
);
$oq->output();
$errs .= "$OQ::DBTYPE does not have Hamill; " unless $OQ::BUF =~ /Hamill/s;
});
is($errs, '', "notcontainsmultivalempty");
}
t/006_noEscapeColMultival.t view on Meta::CPAN
'U_ID' => ['movie','movie.movie_id','Movie ID'],
'TEST' => ['moviecast', "'<a href=123456></a>'", 'TEST']
},
'options' => {
'CGI::OptimalQuery::InteractiveQuery' => {
noEscapeCol => ['TEST'],
}
},
'joins' => {
'movie' => [undef, "oqtest_movie movie"],
'moviecast' => ['movie', 'JOIN oqtest_moviecast moviecast ON (movie.movie_id = moviecast.movie_id)', undef, { new_cursor => 1 }]
}
);
$oq->output();
$errs .= "$OQ::DBTYPE invalid; " if index($OQ::BUF, '<a href=123456></a> <a href=123456></a>') == -1;
});
is($errs, '', "noEscapeColMultival");
t/007_notequalmultival.t view on Meta::CPAN
my $oq = OQ::schema(
'select' => {
'U_ID' => ['movie','movie.movie_id','Movie ID'],
'NAME' => ['movie', 'movie.name', 'Name'],
'CAST' => ['moviecastperson', 'moviecastperson.name', 'All Cast (seprated by commas)']
},
filter => "[CAST] != 'Mark Hamill'",
'module' => 'CSV',
'joins' => {
'movie' => [undef, "oqtest_movie movie"],
'moviecast' => ['movie', 'JOIN oqtest_moviecast moviecast ON (movie.movie_id = moviecast.movie_id)', undef, { new_cursor => 1 }],
'moviecastperson' => ['moviecast', 'JOIN oqtest_person moviecastperson ON (moviecast.person_id=moviecastperson.person_id)']
}
);
$oq->output();
$errs .= "$OQ::DBTYPE has Hamill; " if $OQ::BUF =~ /Hamill/s;
});
is($errs, '', "notequalmultival");