Class-AutoDB
view release on metacpan or search on metacpan
t/autodb.099.docs/docs.014.synopsis.t
t/autodb.099.docs/docs.015.synopsis.t
t/autodb.099.docs/docs.020.pmodel.t
t/autodb.099.docs/docs.023.pmodel.t
t/autodb.099.docs/docs.030.pct_autodb.t
t/autodb.099.docs/docs.031.00.pct_autodb.trans.t
t/autodb.099.docs/docs.031.01.pct_autodb.trans.t
t/autodb.099.docs/docs.035.register.t
t/autodb.099.docs/docs.040.new_n_connect.t
t/autodb.099.docs/docs.042.queries.t
t/autodb.099.docs/docs.043.cursors.t
t/autodb.099.docs/docs.044.updates.t
t/autodb.099.docs/docs.045.schema.t
t/autodb.099.docs/PctAUTODB_0.pm
t/autodb.099.docs/PctAUTODB_1.pm
t/autodb.099.docs/PctAUTODB_AllTypes.pm
t/autodb.099.docs/PctAUTODB_Hash.pm
t/autodb.099.docs/PctAUTODB_Keys.pm
t/autodb.099.docs/PctAUTODB_List.pm
t/autodb.099.docs/PctAUTODB_StdSingle.pm
t/autodb.099.docs/PctAUTODB_Trans.pm
lib/Class/AutoDB.pm view on Meta::CPAN
# NG 09-11-24: move Database first so AutoClass::get will not mask Database::get
# this breaks the usual rule that AutoClass must be first, but it's okay
# since we know Database and Connect do not provide 'new' methods.
# note also that AutoClass redundant here since Database and Connect
# both inherit from AutoClass anyway
use base qw(Class::AutoDB::Database Class::AutoDB::Connect Class::AutoClass);
@AUTO_ATTRIBUTES=qw(read_only read_only_schema alter_param index_param
object_table registry
session cursors
_db_cursor);
@OTHER_ATTRIBUTES=qw(server=>'host');
%SYNONYMS=();
Class::AutoClass::declare;
use vars qw($AUTO_REGISTRY); # TODO: move to Globals
$AUTO_REGISTRY=new Class::AutoDB::Registry;
our $GLOBALS=Class::AutoDB::Globals->instance();
# usual case is compile time registration: autodb not yet set
sub auto_register {
lib/Class/AutoDB.pm view on Meta::CPAN
my @persons=$autodb->get(collection=>'Person'); # everyone
my @males=$autodb->get(collection=>'Person',sex=>'M'); # just the boys
# do something with the retrieved objects, for example, print friends lists
for my $person (@persons) {
my @friend_names=map {$_->name} @{$person->friends};
print $person->name,"'s friends are @friend_names\n";
}
# retrieve and process objects one-by-one
my $cursor=$autodb->find(collection=>'Person');
while (my $person=$cursor->get_next) {
# do what you want with $person, for example, print friends list
my @friend_names=map {$_->name} @{$person->friends};
print $person->name,"'s friends are @friend_names\n";
}
# connect auto-persistent objects with engineered tables
# assume database has human-engineered tables
# Dept(id int, name varchar(255)), EmpDept(emp_id int, dept_id int)
# this query retrieves the names of Joe's departments
use DBI;
lib/Class/AutoDB.pm view on Meta::CPAN
The SQL argument must select a single column which is interpreted as
containing the oids of objects to be retrieved. Our code adds
additional SQL that uses the oids to select objects from _AutoDB.
If you supply search_key=>value pairs and a SQL statement, they are ANDed.
=head3 find
Title : find
Usage : my $cursor=$autodb->find(collection=>'Person',name=>'Joe',sex=>'M')
-- OR --
my $cursor=$autodb->find(collection=>'Person',
query=>{name=>'Joe',sex=>'M'})
-- OR --
my $cursor=$autodb->find
-- OR --
my $cursor=$autodb->find(sql=>qq(SELECT oid FROM Person
WHERE name='Joe' OR name='Bill'))
Function: Execute query.
Returns : Class::AutoDB::Cursor object which can be used to retrieve results
Args : same as 'get'
Notes : same as 'get'
=head3 count
Title : count
Usage : my $count=$autodb->count(collection=>'Person',name=>'Joe',sex=>'M')
-- OR --
my $count=$autodb->count(collection=>'Person',
query=>{name=>'Joe',sex=>'M'})
-- OR --
my $cursor=$autodb->find
-- OR --
my $cursor=$autodb->find(sql=>qq(SELECT oid FROM Person
WHERE name='Joe' OR name='Bill'))
Function: Count number of objects satisfying query
Returns : number
Args : same as 'get'
Notes : same as 'get'
=head3 oid
Title : oid
Usage : my $oid=$autodb->oid($object)
lib/Class/AutoDB.pm view on Meta::CPAN
=head2 Cursors
The methods described here operate on Class::AutoDB::Cursor objects
returned by L<"find">. See L<METHODS AND FUNCTIONS - Queries|"Queries"> for
related methods operating on Class::AutoDB objects.
=head3 get
Title : get
Usage : my @males=$cursor->get
-- OR --
my $males=$cursor->get
Function: Retrieve results of query associated with cursor
Returns : list or ARRAY of objects satisfying query
Args : none
It is possible to mix 'get' and 'get_next' operations. If some
'get_next' operations have been run on cursor, 'get' retrieves
remaining objects
=head3 get_next
Title : get_next
Usage : my $object=$cursor->get_next
Function: Retrieve next result for cursor or undef if there are no more
Returns : object satisfying query or undef
Args : none
Notes : Allows simple while loops to iterate over results as in SYNOPSIS
=head3 count
Title : count
Usage : my $count=$cursor->count
Function: Count number of objects satisfying query associated with cursor
Returns : number
Args : none
=head3 reset
Title : reset
Usage : $cursor->reset
Function: Re-execute query associated with cursor.
Returns : nothing
Args : none
Notes : Subsequent 'get' or 'get_next' operation will start at beginning
=head2 Updates
=head3 put
Title : put
Usage : $autodb->put(@objects)
lib/Class/AutoDB/Database.pm view on Meta::CPAN
integer =>'int',
float =>'double',
object =>'bigint unsigned',);
my @TYPES=keys %TYPES;
my %TYPES_ABBREV=abbrev @TYPES;
# TODO: deal with free-form queries
sub find {
my $self=shift;
my $query=$self->parse_query(@_);
my $cursor=new Class::AutoDB::Cursor(-query=>$query,-dbh=>$self->dbh);
$cursor;
}
sub get {
my $self=shift;
my $cursor=$self->find(@_);
$cursor->get;
}
sub count {
my $self=shift;
my $query=$self->parse_query(@_);
my $cursor=new Class::AutoDB::Cursor(-query=>$query,-dbh=>$self->dbh);
$cursor->count;
}
# NG 10-09-15: moved some code around to handle empty query and raw SQL
sub parse_query {
my $self=shift;
my $args=new Hash::AutoHash::Args(@_);
# NG 09-12-19: $autodb needed to remove $value->oid below
my $autodb=$GLOBALS->autodb;
my $dbh=$self->dbh;
my $object_table=$self->object_table;
my @from=($object_table); # always need_AutoDB
t/autodb.010.putget/putget.011.01.reset.t view on Meta::CPAN
########################################
# test cursor reset using objects stored by previous test
########################################
use t::lib;
use strict;
use Carp;
use Test::More;
use Test::Deep;
use autodbTestObject;
use Class::AutoDB;
use putgetUtil;use Place;
my $autodb=new Class::AutoDB(database=>testdb); # open database
# make 10 objects - Places are as good as any
my @correct_objects=map {new Place(name=>"object $_",id=>id_next())} (0..9);
# %test_args, exported by putgetUtil, sets class2colls, coll2keys, label
my $test=new autodbTestObject(%test_args);
my $correct_objects=\@correct_objects;
my $cursor=$autodb->find(collection=>'Place');
my @actual_objects=$cursor->get;
$test->test_get(labelprefix=>'get:',
correct_objects=>$correct_objects,actual_objects=>\@actual_objects);
# first time around, should be exhausted
my @actual_objects=$cursor->get;
cmp_bag(\@actual_objects,[],'get before reset');
my @actual_objects;
while(my $object=$cursor->get_next) {push(@actual_objects,$object)}
cmp_bag(\@actual_objects,[],'getnext before reset');
# reset and do it again
$cursor->reset;
my @actual_objects=$cursor->get;
$test->test_get(labelprefix=>'get after reset:',
correct_objects=>$correct_objects,actual_objects=>\@actual_objects);
$cursor->reset;
my @actual_objects;
while(my $object=$cursor->get_next) {push(@actual_objects,$object)}
$test->test_get(labelprefix=>'get_next after reset:',
correct_objects=>$correct_objects,actual_objects=>\@actual_objects);
# reset and do it 2 pieces
$cursor->reset;
my @actual_objects;
for my $i (0..4) {push(@actual_objects,$cursor->get_next)}
push(@actual_objects,$cursor->get);
$test->test_get(labelprefix=>'get_next, then get after reset:',
correct_objects=>$correct_objects,actual_objects=>\@actual_objects);
# put another object. reset should see it.
my $object=new Place(name=>"object new",id=>id_next());
$autodb->put($object);
remember_oids($object);
push(@correct_objects,$object);
# reset and do it again
$cursor->reset;
my @actual_objects=$cursor->get;
$test->test_get(labelprefix=>'get after put new object:',
correct_objects=>$correct_objects,actual_objects=>\@actual_objects);
$cursor->reset;
my @actual_objects;
while(my $object=$cursor->get_next) {push(@actual_objects,$object)}
$test->test_get(labelprefix=>'get_next after put new object:',
correct_objects=>$correct_objects,actual_objects=>\@actual_objects);
done_testing();
t/autodb.010.putget/putget.022.01.pnp.t view on Meta::CPAN
sub get_one {
my($name)=@_;
my($actual_object)=$test->do_get({collection=>'Persistent',name=>$name},$get_type,1);
$actual_object;
# my(@actual_objects,$count);
# if ($get_type eq 'get') {
# @actual_objects=$autodb->get($get_args);
# $count=$autodb->count($get_args);
# } elsif ($get_type=~/^find([_-]{0,1}get){0,1}$/) {
# my $cursor=$autodb->find($get_args);
# @actual_objects=$cursor->get;
# $count=$cursor->count;
# } elsif ($get_type=~/^find[_-]{0,1}get[_-]{0,1}next$/) {
# my $cursor=$autodb->find($get_args);
# while (my $object=$cursor->get_next) {
# push(@actual_objects,$object);
# }
# $count=$cursor->count;
# } else {
# confess "invalid get_type $get_type";
# }
# # is($count,scalar @correct_objects,$self->label.'count');
# unless($count==1) {
# report_fail(0,"$get_type $name count");
# diag(' got: '.scalar @actual_objects);
# diag('expect: 1');
# return undef;
# }
t/autodb.015.del/FindDel.pm view on Meta::CPAN
############################################################
# used by 040 series which tests del while cursor active.
# these tests vary 3 params
# 1) the items being deleted can start as objects or Oids
# 2) the active cursor can be 'open' or 'running'
# open means 'find' executed but no get or get_next
# running means 'find' and 1 or more 'get_next', but cursor not exhausted
# 3) post-del, the cursor can be accessed via 'get' (ie, get all) or 'get_next'
#
# this file defines classes and collections for each case, and a 'holder'
# class that organizes them
############################################################
package FindDel;
use base qw(Class::AutoClass);
use vars qw(@AUTO_ATTRIBUTES %DEFAULTS %AUTODB);
use delUtil; # to get id_next
@AUTO_ATTRIBUTES=qw(id name testcase case2objects num_objects);
%DEFAULTS=(testcase=>'top',case2objects=>{},num_objects=>5);
t/autodb.015.del/del.011.23.get.t view on Meta::CPAN
report_fail
(ref $jane,'objects exist - probably have to rerun put script',__FILE__,__LINE__);
# test 'get' queries
my @places=$autodb->get(collection=>'Place');
is(scalar @places,0,'get Place');
my($mit)=$autodb->get(collection=>'Place',name=>'MIT');
ok(!defined($mit),'get MIT');
# test 'find/get' queries
my $cursor=$autodb->find(collection=>'Place');
my @places=$cursor->get;
is(scalar @places,0,'find/get Place');
my $cursor=$autodb->find(collection=>'Place',name=>'MIT');
my($mit)=$cursor->get;
ok(!defined($mit),'find/get MIT');
# test 'find/get_next' queries
my $cursor=$autodb->find(collection=>'Place');
my $place=$cursor->get_next;
ok(!defined($place),'find/get_next Place');
my $cursor=$autodb->find(collection=>'Place',name=>'MIT');
my $mit=$cursor->get_next;
ok(!defined($mit),'find/get_next MIT');
# test 'count' queries
my $count=$autodb->count(collection=>'Place');
is($count,0,'count Place');
my $count=$autodb->count(collection=>'Place',name=>'MIT');
is($count,0,'count MIT');
done_testing();
t/autodb.015.del/del.011.30.put.t view on Meta::CPAN
########################################
# this series tests deletion of objects and Oids while cursor active
# OBSOLETE: superceded by series 040
# this script creates and stores the objects
# a little different from 010.00.put: no hobbies, 5 students, 5 schools
########################################
use t::lib;
use strict;
use Carp;
use List::Util qw(sum);
use Test::More;
use Test::Deep;
t/autodb.015.del/del.011.31.delobj.t view on Meta::CPAN
########################################
# this series tests deletion of objects and Oids while cursor active
# OBSOLETE: superceded by series 040
# this script tests deletion of objects
########################################
use t::lib;
use strict;
use Carp;
use Test::More;
use Test::Deep;
use delUtil;
t/autodb.015.del/del.011.31.delobj.t view on Meta::CPAN
'number of objects - looks like put & del scripts used different params ',__FILE__,__LINE__);
# for sanity, make sure Students present in cache as objects
$ok=1;
for my $i (0..4) {
my $student=$students[$i];
$ok&&=ok_objcache($student,'object','Student','at start: Student in object cache as object',
__FILE__,__LINE__,'no_report_pass');
last unless $ok;
}
# open cursor over Students
my $cursor=$autodb->find(collection=>'Student');
# del some students, then get via cursor
$autodb->del($students[0],$students[2],$students[4]);
my @actual=$cursor->get;
my $count=scalar @actual;
$ok=1;
$ok&&=report_fail
($count==$num_students-3,
"open cursor: number of students. Expected ".($num_students-3)." Got $count",
__FILE__,__LINE__);
if ($ok) {
@actual=sort {$a->name cmp $b->name} @actual;
my @correct=@students[1,3];
($ok,$details)=cmp_details(\@actual,bag(@correct));
report($ok,'open cursor: correct objects',__FILE__,__LINE__,$details);
}
$ok=1;
for my $i (0,2,4) {
my $student=$students[$i];
$ok&&=ok_objcache($student,'OidDeleted','Student','get mangled deleted object in cache',
__FILE__,__LINE__,'no_report_pass');
last unless $ok;
}
for my $i (1,3) {
my $student=$students[$i];
$ok&&=ok_objcache($student,'object','Student','get mangled non-deleted object in cache',
__FILE__,__LINE__,'no_report_pass');
last unless $ok;
}
report_pass($ok,'open cursor: correct object cache after del & get');
# for sanity, make sure Schools present in cache as objects
$ok=1;
for my $i (0..4) {
my $school=$schools[$i];
$ok&&=ok_objcache($school,'object','School','at start: School in object cache as object',
__FILE__,__LINE__,'no_report_pass');
last unless $ok;
}
# open & start cursor over Schools
$ok=1;
my $cursor=$autodb->find(collection=>'Place');
my $school=$cursor->get_next;
# del some schools, then get via cursor
$autodb->del($schools[0],$schools[2],$schools[4]);
my @actual=$cursor->get;
my $count=scalar @actual;
$ok&&=report_fail
($count==$num_schools-3,
"started cursor: number of schools. Expected ".($num_schools-3)." Got $count",
__FILE__,__LINE__);
if ($ok) {
@actual=sort {$a->name cmp $b->name} @actual;
my @correct=@schools[1,3];
($ok,$details)=cmp_details(\@actual,bag(@correct));
report($ok,'started cursor: correct objects',__FILE__,__LINE__,$details);
}
$ok=1;
for my $i (0,2,4) {
my $school=$schools[$i];
$ok&&=ok_objcache($school,'OidDeleted','School','get mangled deleted object in cache',
__FILE__,__LINE__,'no_report_pass');
last unless $ok;
}
for my $i (1,3) {
my $school=$schools[$i];
$ok&&=ok_objcache($school,'object','School','get mangled non-deleted object in cache',
__FILE__,__LINE__,'no_report_pass');
last unless $ok;
}
report_pass($ok,'started cursor: correct object cache after del & get');
done_testing();
t/autodb.015.del/del.040.00.put.t view on Meta::CPAN
########################################
# this series tests deletion of objects and Oids while cursor active
# this script creates and stores the objects
# these tests vary 3 params
# 1) the items being deleted can start as objects or Oids
# 2) the active cursor can be 'open' or 'running'
# open means 'find' executed but no get or get_next
# running means 'find' and 1 or more 'get_next', but cursor not exhausted
# 3) post-del, the cursor can be accessed via 'get' (ie, get all) or 'get_next'
########################################
use t::lib;
use strict;
use Carp;
use Test::More;
use autodbTestObject;
use Class::AutoDB;
use delUtil; use FindDel;
t/autodb.015.del/del.040.01.finddel.t view on Meta::CPAN
########################################
# this series tests deletion of objects and Oids while cursor active
# this script does the main test
# these tests vary 3 params
# 1) the items being deleted can start as objects or Oids
# 2) the active cursor can be 'open' or 'running'
# open means 'find' executed but no get or get_next
# running means 'find' and 1 or more 'get_next', but cursor not exhausted
# 3) post-del, the cursor can be accessed via 'get' (ie, get all) or 'get_next'
########################################
use t::lib;
use strict;
use Carp;
use Test::More;
use Test::Deep;
use delUtil;
use Class::AutoDB;
use delUtil; use FindDel;
t/autodb.015.del/del.040.01.finddel.t view on Meta::CPAN
(scalar @objects==$num_objects,
"objects for case $case exist - probably have to rerun put script",__FILE__,__LINE__);
my $ok=1;
for my $object (@objects) {
$ok&&=ok_objcache($object,$entry_type,'FindDel_case',
"at start: objects for case $case in object cache as $entry_type",
__FILE__,__LINE__,'no_report_pass');
last unless $ok;
}
# process param2: do 'find' and possibly 'get_next'
my $cursor=$autodb->find(collection=>'FindDel',testcase=>$case);
if ($param2 eq 'running') {
my $object=$cursor->get_next;
}
# del some objects/Oids
my @evens=grep {!($_%2)} (0..$num_objects-1);
my @odds=grep {($_%2)} (0..$num_objects-1);
$autodb->del(@objects[@evens]);
# process param3: get objects all-at-once or in a get_next loop
my(@actual,@correct);
if ($param3 eq 'get') {
@actual=$cursor->get;
} else {
while (defined(my $object=$cursor->get_next)) {
push(@actual,$object);
}
}
# now, how did we do?
my $actual_count=scalar @actual;
my $correct_count=$num_objects-scalar @evens;
$ok=1;
$ok&&=report_fail
($actual_count==$correct_count,
"$case: number of object. Expected $correct_count. Got $actual_count",
t/autodb.099.docs/docs.011.synopsis.t view on Meta::CPAN
# print $person->name,"'s friends are @friend_names\n";
push(@friends_strings,$person->name."'s friends are @friend_names\n");
}
cmp_deeply(\@friends_strings,
bag("Joe's friends are Mary Bill\n",
"Mary's friends are Joe Bill\n",
"Bill's friends are Joe Mary\n"),'friends names');
# retrieve and process objects one-by-one
my @friends_strings;
my $cursor=$autodb->find(collection=>'Person');
while (my $person=$cursor->get_next) {
# do what you want with $person, for example, print friends list
my @friend_names=map {$_->name} @{$person->friends};
# print $person->name,"'s friends are @friend_names\n";
push(@friends_strings,$person->name."'s friends are @friend_names\n");
}
cmp_deeply(\@friends_strings,
bag("Joe's friends are Mary Bill\n",
"Mary's friends are Joe Bill\n",
"Bill's friends are Joe Mary\n"),'friends names one-by-one');
t/autodb.099.docs/docs.012.synopsis.t view on Meta::CPAN
use Person;
my $autodb=new Class::AutoDB(database=>testdb); # open database
isa_ok($autodb,'Class::AutoDB','class is Class::AutoDB - sanity check');
################################################################################
# this repeats the last test case of the previous test to make sure 'find' works
# without previous 'get'
# retrieve and process objects one-by-one
my @friends_strings;
my $cursor=$autodb->find(collection=>'Person');
my $i=0;
while (my $person=$cursor->get_next) {
ok_oldoid($person,'person oid '.$i++,qw(Person));
# do what you want with $person, for example, print friends list
my @friend_names=map {$_->name} @{$person->friends};
# print $person->name,"'s friends are @friend_names\n";
push(@friends_strings,$person->name."'s friends are @friend_names\n");
}
cmp_deeply(\@friends_strings,
bag("Joe's friends are Mary Bill\n",
"Mary's friends are Joe Bill\n",
"Bill's friends are Joe Mary\n"),'friends names one-by-one');
t/autodb.099.docs/docs.042.queries.t view on Meta::CPAN
my $all_objects=$autodb->get;
cmp_deeply($all_objects,bag($joe,$mary,$bill),'get form '.$form++);
my @joe_bill=$autodb->get(sql=>qq(SELECT oid FROM Person WHERE name='Joe' OR name='Bill'));
cmp_deeply(\@joe_bill,bag($joe,$bill),'get form '.$form++);
my $joe_bill=$autodb->get(sql=>qq(SELECT oid FROM Person WHERE name='Joe' OR name='Bill'));
cmp_deeply($joe_bill,bag($joe,$bill),'get form '.$form++);
########################################
# find
my $form=1;
my $cursor=$autodb->find(collection=>'Person',name=>'Joe',sex=>'M');
my $males=$cursor->get;
cmp_deeply($males,[$joe],'find form '.$form++);
my $cursor=$autodb->find(collection=>'Person',query=>{name=>'Joe',sex=>'M'});
my $males=$cursor->get;
cmp_deeply($males,[$joe],'find form '.$form++);
my $cursor=$autodb->find;
my $all_objects=$cursor->get;
cmp_deeply($all_objects,bag($joe,$mary,$bill),'find form '.$form++);
my $cursor=$autodb->find(sql=>qq(SELECT oid FROM Person WHERE name='Joe' OR name='Bill'));
my $joe_bill=$cursor->get;
cmp_deeply($joe_bill,bag($joe,$bill),'find form '.$form++);
########################################
# count
my $form=1;
my $count=$autodb->count(collection=>'Person',name=>'Joe',sex=>'M');
is($count,1,'count form '.$form++);
my $count=$autodb->count(collection=>'Person',query=>{name=>'Joe',sex=>'M'});
is($count,1,'count form '.$form++);
t/autodb.099.docs/docs.043.cursors.t view on Meta::CPAN
use t::lib;
use strict;
use Carp;
use Test::More;
use Test::Deep;
use Class::AutoDB;
use autodbUtil;
# test cursor methods documented in METHODS
use Person;
# create database so we can start fresh
my $autodb=new Class::AutoDB(database=>testdb,create=>1);
isa_ok($autodb,'Class::AutoDB','class is Class::AutoDB - sanity check');
# make some objects and put 'em in the database, so we'll have something to query
my $joe=new Person(name=>'Joe',sex=>'M',id=>id_next());
my $mary=new Person(name=>'Mary',sex=>'F',id=>id_next());
my $bill=new Person(name=>'Bill',sex=>'M',id=>id_next());
$joe->friends([$mary,$bill]);
$mary->friends([$joe,$bill]);
$bill->friends([$joe,$mary]);
$autodb->put_objects;
########################################
# get
my $form=1;
my $cursor=$autodb->find(collection=>'Person',name=>'Joe',sex=>'M');
my @males=$cursor->get;
cmp_deeply(\@males,[$joe],'get form '.$form++);
my $cursor=$autodb->find(collection=>'Person',name=>'Joe',sex=>'M');
my $males=$cursor->get;
cmp_deeply($males,[$joe],'get form '.$form++);
########################################
# get_next
my $cursor=$autodb->find(collection=>'Person',name=>'Joe',sex=>'M');
my @males;
while(my $object=$cursor->get_next) {
push(@males,$object);
}
cmp_deeply(\@males,[$joe],'get_next');
########################################
# count
my $cursor=$autodb->find(collection=>'Person',name=>'Joe',sex=>'M');
my $count=$cursor->count;
is($count,1,'count');
########################################
# reset
my $cursor=$autodb->find(collection=>'Person',name=>'Joe',sex=>'M');
my $object=$cursor->get_next;
$cursor->reset;
my $object=$cursor->get_next;
is($object,$joe,'reset');
done_testing();
t/autodb.116.count0.t view on Meta::CPAN
use autodbUtil;
my $autodb=new Class::AutoDB(database=>testdb,create=>1); # create database
isa_ok($autodb,'Class::AutoDB','class is Class::AutoDB - sanity check');
# regression test starts here
my @actual_objects=$autodb->get(collection=>'Person');
is(scalar @actual_objects,0,'get 0');
my $count=$autodb->count(collection=>'Person');
is($count,0,'count 0');
my $cursor=$autodb->find(collection=>'Person');
my $count=$cursor->count;
is($count,0,'cursor count 0');
my $jack=new Person(name=>'Jack');
$autodb->put($jack);
my @actual_objects=$autodb->get(collection=>'Person');
is(scalar @actual_objects,1,'get 1');
my $count=$autodb->count(collection=>'Person');
is($count,1,'count 1');
my $cursor=$autodb->find(collection=>'Person');
my $count=$cursor->count;
is($count,1,'cursor count 1');
done_testing();
t/autodb.117.getbase_multi.t view on Meta::CPAN
my $autodb=new Class::AutoDB(database=>testdb,create=>1); # create database
isa_ok($autodb,'Class::AutoDB','class is Class::AutoDB - sanity check');
# regression test starts here
# attempt query. should be illegal
my $actual_count=eval {$autodb->count(collection=>'Test',multi=>1,multi=>2)};
like($@,qr/repeated/,'count illegal as expected');
my @actual_objects=eval {$autodb->get(collection=>'Test',multi=>1,multi=>2)};
like($@,qr/repeated/,'get illegal as expected');
my $cursor=eval {$autodb->find(collection=>'Test',multi=>1,multi=>2)};
like($@,qr/repeated/,'find illegal as expected');
done_testing();
t/autodb.119.01.upd_list.t view on Meta::CPAN
use Carp;
use Test::More;
use Test::Deep;
use Class::AutoDB;
use autodbUtil;
use autodb_119;
my $autodb=new Class::AutoDB(-database=>testdb);
# retrieve and check
my $cursor=$autodb->find(-collection=>'Person',-name=>'Joe');
my $joe=$cursor->get->[0];
is(ref $joe,'Person','before put: Joe is a Person');
is(scalar @{$joe->friends},2,'before put: Joe has 2 friends');
my $mary=$joe->friends->[0];
ok(ref $mary,'before put: Mary via Joe is an object');
is($mary->name,'Mary','before put: Mary has correct name');
my $bill=$joe->friends->[1];
ok(ref $bill,'before put: Bill via Joe is an object');
is($bill->name,'Bill','before put: Bill has correct name');
# change Joe's name, put object, and retest
$joe->name('Joey');
$joe->put;
my $bill=$joe->friends->[1];
ok(ref $bill,"after changing Joe's name: Bill via Joe is an object");
is($bill->name,'Bill',"after changing Joe's name: Bill has correct name");
# fetch again and retest
my $cursor=$autodb->find(-collection=>'Person',-name=>'Joey');
my $joey=$cursor->get->[0];
is($joey,$joe,'after refetch: Joey and Joe are same object');
is(ref $joey,'Person','after refetch: Joey is a Person');
is(scalar @{$joey->friends},2,'after refetch: Joey has 2 friends');
my $mary=$joey->friends->[0];
ok(ref $mary,'after refetch: Mary via Joe is an object');
is($mary->name,'Mary','after refetch: Mary has correct name');
my $bill=$joey->friends->[1];
ok(ref $bill,'after refetch: Bill via Joey is an object');
is($bill->name,'Bill','after refetch: Bill has correct name');
# change Joey's friends, put object, and retest
$joey->friends->[0]=$joey;
$joey->friends->[1]=$mary;
$joey->friends->[2]=$bill;
$joey->put;
my $bill=$joey->friends->[2];
ok(ref $bill,"after changing Joey's friends: Bill via Joe is an object");
is($bill->name,'Bill',"after changing Joey's friends: Bill has correct name");
# fetch again and retest
my $cursor=$autodb->find(-collection=>'Person',-name=>'Joey');
my $joey=$cursor->get->[0];
is(ref $joey,'Person','after refetch: Joey is a Person');
is(scalar @{$joey->friends},3,'after refetch: Joey has 3 friends');
my $new_joey=$joey->friends->[0];
ok(ref $new_joey,'after refetch: Joey via Joey is an object');
is($new_joey->name,'Joey','after refetch: Joey has correct name');
my $mary=$joey->friends->[1];
ok(ref $mary,'after refetch: Mary via Joe is an object');
is($mary->name,'Mary','after refetch: Mary has correct name');
my $bill=$joey->friends->[2];
ok(ref $bill,'after refetch: Bill via Joey is an object');
is($bill->name,'Bill','after refetch: Bill has correct name');
# change Joey but don't put. then refetch
$joey->name('Joseph');
is($joey->name,'Joseph',"before put: Joey's name changed");
my $cursor=$autodb->find(-collection=>'Person',-name=>'Joey');
my $joey=$cursor->get->[0];
is($joey->name,'Joseph',"after refetch: Joey's name still changed");
done_testing();
t/autodbTestObject.pm view on Meta::CPAN
confess 'need to query database but get_args not set' unless $get_args;
my(@actual_objects,$actual_count);
if ('CODE' eq ref $get_args) {
my %get_args=&$get_args($self);
$get_args=\%get_args;
}
if ($get_type eq 'get') {
@actual_objects=autodb->get($get_args);
$actual_count=autodb->count($get_args);
} elsif ($get_type=~/^find([_-]{0,1}get){0,1}$/) {
my $cursor=autodb->find($get_args);
@actual_objects=$cursor->get;
$actual_count=$cursor->count;
} elsif ($get_type=~/^find[_-]{0,1}get[_-]{0,1}next$/) {
my $cursor=autodb->find($get_args);
while (my $object=$cursor->get_next) {
push(@actual_objects,$object);
}
$actual_count=$cursor->count;
} else {
confess "invalid get_type $get_type";
}
# is($actual_count,scalar @correct_objects,$self->label.'count');
unless($actual_count==$correct_count) {
report_fail(0,$self->label.'count');
diag(" got: $actual_count");
diag("expect: $correct_count");
}
wantarray? @actual_objects: \@actual_objects;
( run in 0.344 second using v1.01-cache-2.11-cpan-4d50c553e7e )