Re: Annouce: DBIx::Class, a.k.a "taking the easy way out"

[prev] [thread] [next] [Date index for 2005/07/26]

From: Tony Bowden
Subject: Re: Annouce: DBIx::Class, a.k.a "taking the easy way out"
Date: 07:27 on 26 Jul 2005
On Tue, Jul 26, 2005 at 12:10:49AM +0100, Matt S Trout wrote:
> > At the weekend I pretty much implemented my new Search approach to
> > Class::DBI. It will work in the same sort of way as Relationships.
> Please, please have a poke at the way I've done Relationship.pm in
> DBIx::Class - it's maybe not Right but it lets me get has_a and has_many
> with minimal effort and joins are a lot less hassle as well.

I have. I don't understand what you're suggesting. Unless I'm
misunderstanding you're taking exactly the opposite approach, and moving
it away from the easy ability for people to extend it. Instead you're
restricting people much more to your interface, which might work well
for what some people want to do, but doesn't fit my brane, and I'm not
convinced it makes it easier for people who want to add all sorts of
insane relationships that I can't really conceive of yet.  I don't see
what there is to copy here...

> > I think it's fairly clean although I'm still trying a couple of different
> > options about how it injects SQL that it needs.
> That sounds pretty nice, although I do hope you make it easy enough to write
> one for Abstract for those of us who like it.

Yes. It should be trivial. Before releasing it I want to take some
of the Search code that's already out there and make sure it can be
migrated easily. (Or if someone else now wants to do this, even better!)

Note also, that the code already out there will all still work. Even if
they relied on overriding private methods, it should all still work as
I'm not changing any of that interface yet. People don't need to rewrite
their Search override code. I'm just providing a better way for people
to provide this in the future.

The test code added shows how easily it is to add "LIMIT" functionality,
which people seem to clamour for regularly. It can't go in Class::DBI
core because it's not standard how different databases handle it, but
I'll now be able to add it cleanly in Class::DBI::mysql.

> SHOW US THE CODE!
> SHOW US THE CODE!
> SHOW US THE CODE!

As I said I'm hoping to get it in a position to do that later in the
week. There is no sensible way to present it at the minute, beyond just
including code in the post, as below.

The _do_search stuff has to survive because it was a semi-officially
blessed way for people to add new behaviour for ILIKE, RLIKE etc. Ideally,
search_like would inject a subclass of Basic that just overrides the
'type' method. I will do that before release, but whilst developing I
wanted to keep one method that worked each way to make sure that both
still work.

Tony

-------------

package Class::DBI;

...

__PACKAGE__->add_searcher(
  search => "Class::DBI::Search::Basic",
);

sub add_searcher {
  my ($self, %rels) = @_;
  while (my ($name, $class) = each %rels) {
    $self->_require_class($class);
    $self->_croak("$class is not a valid Searcher")
    unless $class->can('run_search');
      no strict 'refs';
      *{"$self\::$name"} = sub {
      $class->new(@_)->run_search;
    };
  }
}

sub search_like { shift->_do_search(LIKE => @_) }

sub _do_search {
  my ($class, $type, @args) = @_;
  $class->_require_class('Class::DBI::Search::Basic');
  my $search = Class::DBI::Search::Basic->new($class, @args);
  $search->type($type);
  $search->run_search;
}

-------------

package Class::DBI::Search::Basic;

use strict;
use warnings;

use base 'Class::Accessor::Fast';
__PACKAGE__->mk_accessors(qw/class args opts type/);

sub new {
  my ($me, $proto, @args) = @_;
  my ($args, $opts) = $me->_unpack_args(@args);
  bless {
    class => ref $proto || $proto,
    args  => $args,
    opts  => $opts,
    type  => "=",
  } => $me;
}

sub opt {
  my ($self, $option) = @_;
  $self->{opts}->{$option};
}

sub _unpack_args {
  my ($self, @args) = @_;
  @args = %{ $args[0] } if ref $args[0] eq "HASH";
  my $opts = @args % 2 ? pop @args : {};
  return (\@args, $opts);
}

sub _search_for {
  my $self = shift;
  my @args = @{ $self->{args} };
  my $class = $self->{class};
  my %search_for;
  while (my ($col, $val) = splice @args, 0, 2) {
    my $column = $class->find_column($col)
      || (List::Util::first { $_->accessor eq $col } $class->columns)
      || $class->_croak("$col is not a column of $class");
    $search_for{$column} = $class->_deflated_column($column, $val);
  }
  return \%search_for;
}

sub _qual_bind {
  my $self = shift;
  $self->{_qual_bind} ||= do {
    my $search_for = $self->_search_for;
    my $type = $self->type;
    my (@qual, @bind);
    for my $column (sort keys %$search_for) { # sort for prepare_cached
      if (defined(my $value = $search_for->{$column})) {
        push @qual, "$column $type ?";
        push @bind, $value;
      } else {
        # perhaps _carp if $type ne "="
        push @qual, "$column IS NULL";
      }
    }
    [\@qual, \@bind];
  };
}

sub _qual {
  my $self = shift;
  $self->{_qual} ||= $self->_qual_bind->[0];
}

sub bind {
  my $self = shift;
  $self->{_bind} ||= $self->_qual_bind->[1];
}

sub fragment {
  my $self = shift;
  my $frag = join " AND ", @{ $self->_qual };
  if (my $order = $self->opt('order_by')) {
    $frag .= " ORDER BY $order"
  }
  return $frag;
}

sub sql {
  my $self = shift;
  return $self->class->sql_Retrieve($self->fragment);
}

sub run_search {
  my $self = shift;
  my $cdbi = $self->class;
  return $cdbi->sth_to_objects($self->sql, $self->bind);
}

1;

--------

Added to t/10-mysql.t:

{
  package Class::DBI::Search::Limited;
  use base 'Class::DBI::Search::Basic';

  sub fragment {
    my $self = shift;
    my $frag = $self->SUPER::fragment;
    if (defined(my $limit = $self->opt('limit'))) {
        $frag .= " LIMIT $limit"
    }
    return $frag;
  }

  package main;

  MyFilm->add_searcher(search => "Class::DBI::Search::Limited");

  my @common = map MyFilm->create({ title => "Common Title" }), 1 .. 3;
  {
    my @ltd = MyFilm->search(title => "Common Title", {
      order_by => 'filmid', limit => 1
    });
    is @ltd, 1, "Limit to one film";
    is $ltd[0]->id, $common[0]->id, "The correct one";
  }

  {
    my @ltd = MyFilm->search(title => "Common Title", {
      order_by => 'filmid', limit => "1,1"
    });
    is @ltd, 1, "Limit to middle film";
    is $ltd[0]->id, $common[1]->id, " - correctly";
  }

}

(message missing)

Delegation vs Hooks (was: Annouce: DBIx::Class, a.k.a "taking the easy way out")
=?ISO-8859-1?Q?Ask_Bj=F8rn_Hansen?= 23:27 on 26 Jul 2005

Re: Annouce: DBIx::Class, a.k.a "taking the easy way out"
Tony Bowden 07:27 on 26 Jul 2005

Generated at 16:36 on 28 Jul 2005 by mariachi v0.52