CGI-OptimalQuery

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

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

README  view on Meta::CPAN

      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");



( run in 0.294 second using v1.01-cache-2.11-cpan-4d50c553e7e )