view release on metacpan or  search on metacpan

lib/Algorithm/SpatialIndex/Storage/DBI.pm  view on Meta::CPAN

  if (not defined $id) {
    $sth = $dbh->prepare_cached($self->{_write_new_node_sql});
    my $coords = $node->coords;
    my $snids = $node->subnode_ids;
    my @args = (
      @$coords,
      ((undef) x ($self->no_of_coords - @$coords)),
      @$snids,
      ((undef) x ($self->no_of_subnodes - @$snids))
    );
    $sth->execute(@args);
    $id = $dbh->last_insert_id('', '', '', ''); # FIXME NOT PORTABLE LIKE THAT
    $node->id($id);
  }
  else {
    $sth = $dbh->prepare_cached($self->{_write_node_sql});
    $sth->execute($id, @{$node->coords}, @{$node->subnode_ids}, $id);
  }
  $sth->finish();
  return $id;
}

sub get_option {
  my $self = shift;
  return $self->{config}->{shift()}; # We assume this data changes RARELY
}

sub set_option {
  my $self  = shift;
  my $key   = shift;
  my $value = shift;

  $self->{config}->{$key} = $value;
  $self->_write_config(); # FIXME wasteful
}

sub store_bucket {
  my $self   = shift;
  my $bucket = shift;
  my $dbh = $self->dbh_rw;
  my $id = $bucket->node_id;
  my $sql = $self->{buckets_insert_sql};
  my $is_sub = ref($sql) eq 'CODE';
  if (!$is_sub) {
    my $sth = $dbh->prepare_cached($sql->[0]);
    my $d = [$id, map {@$_} @{$bucket->items}];
    $sth->execute(map $d->[$_], @{$sql}[1..$#$sql]);
    my $err = $sth->errstr; die $err if $err;
    $sth->finish;
  }
  else {
    $sql->($id, map {@$_} @{$bucket->items});
  }
}

sub fetch_bucket {
  my $self    = shift;
  my $node_id = shift;
  my $dbh = $self->dbh_ro;
  my $selsql = $self->{buckets_select_sql};
# This throws SEGV in the driver
  #my $sth = $dbh->prepare_cached($selsql);
  #$sth->execute($node_id) or die $dbh->errstr;
  #my $row = $sth->fetchrow_arrayref;
  #$sth->finish;
  my $rows = $dbh->selectall_arrayref($selsql, {}, $node_id);
  my $row = $rows->[0];
  return undef if not defined $row;
  my $items = [];
  my $n = scalar(@{$self->item_coord_types}) + 1;
  while (@$row > 1) {
    my $item = [splice(@$row, 1, $n)];
    next if not defined $item->[0];
    push @$items, $item;
  }
  my $bucket = $self->bucket_class->new(node_id => $node_id, items => $items);
  return $bucket;
}

sub delete_bucket {
  my $self    = shift;
  my $node_id = shift;
  $node_id = $node_id->node_id if ref($node_id);
  my $tname = $self->table_prefix . '_buckets';
  $self->dbh_rw->do(qq{DELETE FROM $tname WHERE node_id=?}, {}, $node_id);
  return();
}


=head2 _coord_types_to_sql

Given an array ref containing coordinate type strings
(cf. L<Algorithm::SpatialIndex::Strategy>),
stores the SQL fragments for C<SELECT>
and C<CREATE TABLE> for the node coordinates.

The coordinates will be called C<c$i> where C<$i>
starts at 0.

=cut

sub _coord_types_to_sql {
  my $self = shift;
  my $types = shift;

  my %types = (
    float    => 'FLOAT',
    double   => 'DOUBLE',
    integer  => 'INTEGER',
    unsigned => 'INTEGER UNSIGNED',
  );
  my $create_sql = '';
  my $select_sql = '';
  my $insert_sql = '';
  my $i = 0;
  foreach my $type (@$types) {
    my $sql_type = $types{lc($type)};
    die "Invalid coord type '$type'" if not defined $sql_type;
    $create_sql .= "  c$i $sql_type, ";
    $select_sql .= "  c$i, ";
    $insert_sql .= " c$i=?, ";