Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Implemented DBIC ResultSet adaptor as a KVPairs

  • Loading branch information...
commit a984de178e7a08996dfae07dbe30ab6e1806fe2a 1 parent 8d110d8
@jeteve authored
View
2  JCOM-BM/lib/JCOM/KVPairs.pm
@@ -18,7 +18,7 @@ Usage:
=cut
sub size{
- my ($self);
+ my ($self) = @_;
confess("Please implement this in $self");
}
View
75 JCOM-BM/lib/JCOM/KVPairs/DBICRs.pm
@@ -0,0 +1,75 @@
+package JCOM::KVPairs::DBICRs;
+use Moose;
+extends qw/JCOM::KVPairs/;
+
+=head1 NAME
+
+JCOM::KVPairs::DBICRs - A DBIx::Class::ResultSet adapter.
+
+=head1 SYNOPSIS
+
+ my $set = JCOM::KVPairs::DBICRs->new({ rs => $a_dbic_resultset,
+ key => 'the_id_column',
+ value => 'the_value_column' });
+
+Note that key defaults to 'id'
+
+Then use as a L<JCOM::KVPairs>.
+
+=head1 CAVEATS
+
+Doesn't manage composed keys for now.
+
+=cut
+
+has 'rs' => ( isa => 'DBIx::Class::ResultSet', is => 'ro' , required => 1 );
+has 'key' => ( isa => 'Str' , is => 'ro' , required => 1 , default => 'id' );
+has 'value' => ( isa => 'Str' , is => 'ro', required => 1 );
+
+has '_search_rs' => ( isa => 'DBIx::Class::ResultSet', is => 'rw' , clearer => 'clear_search_rs' );
+
+=head2 size
+
+See superclass L<JCOM::KVPairs>
+
+=cut
+
+sub size{
+ my ($self) = @_;
+ return $self->rs->count();
+}
+
+=head2 next_kvpair
+
+See superclass L<JCOM::KVPairs>
+
+=cut
+
+sub next_kvpair{
+ my ($self) = @_;
+
+ my $srs = $self->_search_rs();
+ unless( $srs ){
+ $srs = $self->_search_rs($self->rs->search_rs());
+ }
+
+ my $next_row = $srs->next();
+ unless( $next_row ){
+ $self->clear_search_rs();
+ return ();
+ }
+
+ my ( $key , $value ) = ( $self->key() , $self->value() );
+ return ( $next_row->$key() , $next_row->$value() );
+}
+
+sub lookup{
+ my ($self, $lookup_key) = @_;
+ my ($key , $value ) = ( $self->key() , $self->value() );
+ if( my $row = $self->rs->find({ $key => $lookup_key }) ){
+ return ( $row->$key() , $row->$value() );
+ }
+ return undef;
+}
+
+1;
View
2  JCOM-BM/t/01-dbic_wrapper.t
@@ -81,7 +81,7 @@ ok( $dbh->do('CREATE TABLE builder(id INTEGER PRIMARY KEY AUTOINCREMENT, bname V
ok( $dbh->do('CREATE TABLE product(id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255), active BOOLEAN DEFAULT FALSE, colour VARCHAR(10) NOT NULL DEFAULT \'blue\', builder_id INTEGER,FOREIGN KEY (builder_id) REFERENCES builder(id))') , "Ok creating product table");
## Build a schema dynamically.
-ok( my $schema = My::Schema->connect(sub{ return $dbh ;} ), "Ok built schema with dbh");
+ok( my $schema = My::Schema->connect(sub{ return $dbh ;} , { unsafe => 1 } ), "Ok built schema with dbh");
## Just to check
ok( $schema->resultset('Builder') , "Builder resultset is there");
ok( $schema->resultset('Product') , "Product resultset is there");
View
61 JCOM-BM/t/03-kvpairs.t
@@ -1,24 +1,57 @@
#!perl -T
use Test::More;
use JCOM::KVPairs::Pure;
+use JCOM::KVPairs::DBICRs;
-ok( my $set = JCOM::KVPairs::Pure->new({ array => [ { 1 => 'One'},
- { 2 => 'Two'},
- { 3 => 'Three' }
- ]}) , "Ok can build set");
+use DBI;
+use DBD::SQLite;
-cmp_ok( $set->size(), '==' , 3 , "Ok size is good");
-my $it = 0;
-while( my @kv = $set->next_kvpair() ){
- $it++;
+package My::Schema;
+use base qw/DBIx::Class::Schema::Loader/;
+__PACKAGE__->naming('current');
+1;
+package main;
+
+
+
+## Testing pure kvpairs
+ok( my $pure_set = JCOM::KVPairs::Pure->new({ array => [ { 1 => 'Thing1'},
+ { 2 => 'Thing2'},
+ { 3 => 'Thing3' }
+ ]}) , "Ok can build set");
+push @sets , $pure_set;
+
+## Building a DBIC Base set.
+my $dbh = DBI->connect("dbi:SQLite::memory:" , "" , "");
+$dbh->{AutoCommit} = 1 ;
+$dbh->do('CREATE TABLE thing(id INTEGER PRIMARY KEY, title VARCHAR(255) UNIQUE NOT NULL)');
+my $schema = My::Schema->connect(sub{ return $dbh ;} , { unsafe => 1 });
+my $rs = $schema->resultset('Thing');
+foreach my $i ( 1..3 ){
+ $rs->create({ id => $i , title => 'Thing'.$i});
}
-cmp_ok( $it , '==' , 3 , "We went though the iteration 3 times");
-my @kv = $set->next_kvpair();
-cmp_ok( @kv[0] , '==' , 1 , "Got first kv pair (1)");
-cmp_ok( @kv[1] , 'eq' , 'One' , "And it matches 'One'");
+ok( my $dbic_set = JCOM::KVPairs::DBICRs->new({ rs => $rs,
+ key => 'id',
+ value => 'title'
+ }) , "Ok can build a dbic resultset base set");
+push @sets , $dbic_set;
-ok( my $two = $set->lookup(2) , "Ok can lookup 2");
-cmp_ok( $two , 'eq' , 'Two' , "Got the right thing back");
+foreach my $set ( @sets ){
+ cmp_ok( $set->size(), '==' , 3 , "Ok size is good");
+ my $it = 0;
+ while ( my @kv = $set->next_kvpair() ) {
+ $it++;
+ }
+ cmp_ok( $it , '==' , 3 , "We went though the iteration 3 times");
+
+ my @kv = $set->next_kvpair();
+ cmp_ok( @kv[0] , '==' , 1 , "Got first kv pair (1)");
+ cmp_ok( @kv[1] , 'eq' , 'Thing1' , "And it matches 'Thing1'");
+
+ ok( my $two = $set->lookup(2) , "Ok can lookup 2");
+ cmp_ok( $two , 'eq' , 'Thing2' , "Got the right thing back");
+ ok( ! $set->lookup(47), "Cannot lookup 47");
+}
done_testing();
Please sign in to comment.
Something went wrong with that request. Please try again.