Class::DBI::Plugin::AccessionSearch

なんかCPANにアップできるようなのをなんかつくりたかったの
だからなんか適当につくってみたの。。。
いや、適当でもないいんだけど。
こういうの必要ないかなぁ。ないかなぁ。ないかなぁ。

package Class::DBI::Plugin::AccessionSearch;

use strict;

use warnings;

use base qw/Class::DBI::Plugin/;
sub accession : Plugged {

    my($pkg, $where, $attrs) = @_;
    my $param = {

        pkg   => $pkg,

        where => $where,

        attrs => $attrs,

    };
    bless $param , __PACKAGE__;

}
sub acession_search : Plugged {

    my ($self, $where, $attrs) = @_;
    $where = {} unless $where;

    $attrs = {} unless $attrs;
    my $our_where = $self->{where} || {};

    my $new_where = { %{$our_where} , %{$where} };
    my $our_atters = $self->{attrs} || {};

    my $new_attrs = { %{$our_atters} , %{$attrs} };
    $self->{where} = $new_where;

    $self->{attrs} = $new_attrs;
    return $self->{pkg}->search_where($new_where,$new_attrs);

}
1;

こんな感じで使うかな

#! /usr/bin/perl

use strict;

use warnings;

use Proj::Data::User;
my $c = Proj::Data::User->accession({status => 'ok'});
my $it = $c->acession_search();

warn $it->sql;

warn join ',', @{$it->args}, "\n";

warn '# -------------------------------------------------------------------------#';
$it = $c->acession_search({sex => 'male'});

warn $it->sql;

warn join ',', @{$it->args}, "\n";

warn '# -------------------------------------------------------------------------#';
$it = $c->acession_search({status => 'ng'});

warn $it->sql;

warn join ',', @{$it->args}, "\n";

warn '# -------------------------------------------------------------------------#';
$it = $c->acession_search({},{order_by => 'id'});

warn $it->sql;

warn join ',', @{$it->args}, "\n";

warn '# -------------------------------------------------------------------------#';