From 88faac39628680169aee2e2ba23556aa003b49da Mon Sep 17 00:00:00 2001 From: JT Smith Date: Sun, 20 Dec 2009 22:35:25 -0600 Subject: [PATCH] converted to item centric subclassing --- Changes | 7 +- author.t/04.Select.t | 46 +++--- author.t/05.Domain_and_Item.t | 10 +- author.t/lib/Foo/Child.pm | 4 +- author.t/lib/Foo/Domain.pm | 5 +- author.t/lib/Foo/Parent.pm | 4 +- dist.ini | 3 +- lib/SimpleDB/Class.pm | 139 +++++----------- lib/SimpleDB/Class/Domain.pm | 184 ++++----------------- lib/SimpleDB/Class/Item.pm | 285 ++++++++++++++++++++------------ lib/SimpleDB/Class/ResultSet.pm | 76 ++++++--- lib/SimpleDB/Class/SQL.pm | 37 +++-- t/03.Class.t | 44 ++++- t/05.Domain.t | 24 --- t/07.Item.t | 38 ----- 15 files changed, 401 insertions(+), 505 deletions(-) delete mode 100644 t/05.Domain.t delete mode 100644 t/07.Item.t diff --git a/Changes b/Changes index a296367..1148aa3 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,9 @@ -0.0201 - 2009-12-25 +0.0300 - 2009-12-20 + - Rethought the whole subclassing approach. Now subclassing the result rather than the domain, and everything is much cooler, and is much closer to DBIx::Class. Check out the docs for API changes. + - While rewriting discovered that all relationship and attribute methods were global (all classes in the schema got them), which is a huge bug. This problemhas been eliminated in this version as well. + - Added Sub::Name to the prereqs. + +0.0201 - 2009-12-19 - Some documentation fixes. - Cleaned up relationship code. - Attempted in-item indexed relationships, but abandoned it due to race conditions. Check out commits a3c651797a5d3924be129300bf08500e0e3c6f2d and 04709b014317d9c15dc265323cde71a647e072d9 to investigate in the future. diff --git a/author.t/04.Select.t b/author.t/04.Select.t index f49d68c..9f7db31 100644 --- a/author.t/04.Select.t +++ b/author.t/04.Select.t @@ -12,7 +12,7 @@ unless (defined $access && defined $secret) { } -use Foo; +use Foo (); my $foo = Foo->new(secret_key=>$secret, access_key=>$access, cache_servers=>[{host=>'127.0.0.1', port=>11211}]); @@ -20,7 +20,7 @@ my $domain = $foo->domain('foo_domain'); use_ok( 'SimpleDB::Class::SQL' ); my $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, ); isa_ok($select, 'SimpleDB::Class::SQL'); @@ -35,118 +35,118 @@ is($select->format_value('unknown', 'that'), q{'that'}, "format a string"); is($select->format_int(45), q{1000000045}, "format a number"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, output => 'count(*)', ); is($select->to_sql, 'select count(*) from `foo_domain`', "count query"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, output => 'color', ); is($select->to_sql, 'select `color` from `foo_domain`', "single item output query"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, output => ['color','size'], ); is($select->to_sql, 'select `color`, `size` from `foo_domain`', "multi-item output query"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, limit => 44, ); is($select->to_sql, 'select * from `foo_domain` limit 44', "limit query"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, order_by => 'color', ); is($select->to_sql, 'select * from `foo_domain` order by `color` asc', "sort query"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, order_by => ['color','desc'], ); is($select->to_sql, 'select * from `foo_domain` order by `color` desc', "sort query descending"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, order_by => ['color'], ); is($select->to_sql, 'select * from `foo_domain` order by `color` desc', "sort query implied descending"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'quantity' => ['>', 3]}, ); is($select->to_sql, "select * from `foo_domain` where `quantity`>'1000000003'", "query with < where"); my $dt = DateTime->now; $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'start_date' => ['<', $dt]}, ); is($select->to_sql, "select * from `foo_domain` where `start_date`<'".DateTime::Format::Strptime::strftime('%Y-%m-%d %H:%M:%S %N %z',$dt)."'", "query with < where"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'quantity' => ['>=', -99999]}, ); is($select->to_sql, "select * from `foo_domain` where `quantity`>='0999900001'", "query with >= where"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'color' => ['<=', '3']}, ); is($select->to_sql, "select * from `foo_domain` where `color`<='3'", "query with <= where"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'color' => ['!=', '3']}, ); is($select->to_sql, "select * from `foo_domain` where `color`!='3'", "query with != where"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'color' => ['like', '3%']}, ); is($select->to_sql, "select * from `foo_domain` where `color` like '3%'", "query with like where"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'color' => ['not like', '3%']}, ); is($select->to_sql, "select * from `foo_domain` where `color` not like '3%'", "query with not like where"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'color' => ['between', 2,5]}, ); is($select->to_sql, "select * from `foo_domain` where `color` between '2' and '5'", "query with between where"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'color' => ['in', 2,5,7]}, ); is($select->to_sql, "select * from `foo_domain` where `color` in ('2', '5', '7')", "query with in where"); $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { 'color' => ['every', 2,5,7]}, ); is($select->to_sql, "select * from `foo_domain` where every(`color`) in ('2', '5', '7')", "query with every where"); tie my %intersection, 'Tie::IxHash', color=>2, size=>'this'; $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { '-intersection' => \%intersection}, ); is($select->to_sql, "select * from `foo_domain` where (`color`='2' intersection `size`='this')", "query with or where"); tie my %or, 'Tie::IxHash', color=>2, size=>'this'; $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { '-or' => \%or}, ); is($select->to_sql, "select * from `foo_domain` where (`color`='2' or `size`='this')", "query with or where"); @@ -154,14 +154,14 @@ is($select->to_sql, "select * from `foo_domain` where (`color`='2' or `size`='th tie my %and, 'Tie::IxHash', size=>'this', that=>1; tie my %or, 'Tie::IxHash', color=>2, '-and'=>\%and; $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, where => { '-or' => \%or}, ); is($select->to_sql, "select * from `foo_domain` where (`color`='2' or (`size`='this' and `that`='1'))", "query with or where"); tie my %where, 'Tie::IxHash', color=>2, size=>'this'; $select = SimpleDB::Class::SQL->new( - domain => $domain, + item_class => $domain->item_class, order_by => ['color'], limit => 44, where => \%where, diff --git a/author.t/05.Domain_and_Item.t b/author.t/05.Domain_and_Item.t index b03c702..b84f080 100644 --- a/author.t/05.Domain_and_Item.t +++ b/author.t/05.Domain_and_Item.t @@ -1,4 +1,4 @@ -use Test::More tests => 17; +use Test::More tests => 18; use Test::Deep; use lib ('../lib', 'lib'); @@ -10,13 +10,12 @@ unless (defined $access && defined $secret) { die "You need to set environment variables SIMPLEDB_ACCESS_KEY and SIMPLEDB_SECRET_KEY to run these tests."; } - use Foo; my $foo = Foo->new(secret_key=>$secret, access_key=>$access, cache_servers=>[{host=>'127.0.0.1', port=>11211}]); $foo->cache->flush; my $domain = $foo->domain('foo_domain'); -isa_ok($domain,'Foo::Domain'); +isa_ok($domain,'SimpleDB::Class::Domain'); isa_ok($domain->simpledb,'SimpleDB::Class'); my $parent = $foo->domain('foo_parent'); @@ -34,12 +33,13 @@ ok($domain->insert({color=>'blue',size=>'small',parentId=>'two'}), 'adding item is($domain->find('largered')->size, 'large', 'find() works'); my $x = $domain->insert({color=>'orange',size=>'large',parentId=>'one'}); -cmp_deeply($x->to_hashref, {color=>'orange',size=>'large',parentId=>'one'}, 'to_hashref()'); +isa_ok($x, 'Foo::Domain'); +cmp_deeply($x->to_hashref, {color=>'orange',size=>'large',parentId=>'one', start_date=>undef, quantity=>undef}, 'to_hashref()'); $domain->insert({color=>'green',size=>'small',parentId=>'two'}); $domain->insert({color=>'black',size=>'huge',parentId=>'one'}); my $foos = $domain->search({size=>'small'}); isa_ok($foos, 'SimpleDB::Class::ResultSet'); -isa_ok($foos->next, 'SimpleDB::Class::Item'); +isa_ok($foos->next, 'Foo::Domain'); is($foos->next->size, 'small', 'fetched an item from the result set'); my $child = $foo->domain('foo_child'); diff --git a/author.t/lib/Foo/Child.pm b/author.t/lib/Foo/Child.pm index 1ff2527..fcda73a 100644 --- a/author.t/lib/Foo/Child.pm +++ b/author.t/lib/Foo/Child.pm @@ -1,9 +1,9 @@ package Foo::Child; use Moose; -extends 'SimpleDB::Class::Domain'; +extends 'SimpleDB::Class::Item'; -__PACKAGE__->set_name('foo_child'); +__PACKAGE__->set_domain_name('foo_child'); __PACKAGE__->add_attributes(domainId=>{isa=>'Str'}); __PACKAGE__->belongs_to('domain', 'Foo::Domain', 'domainId'); diff --git a/author.t/lib/Foo/Domain.pm b/author.t/lib/Foo/Domain.pm index 20bf8c8..84f0281 100644 --- a/author.t/lib/Foo/Domain.pm +++ b/author.t/lib/Foo/Domain.pm @@ -1,9 +1,9 @@ package Foo::Domain; use Moose; -extends 'SimpleDB::Class::Domain'; +extends 'SimpleDB::Class::Item'; -__PACKAGE__->set_name('foo_domain'); +__PACKAGE__->set_domain_name('foo_domain'); __PACKAGE__->add_attributes( color =>{isa=>'Str'}, size =>{isa=>'Str'}, @@ -14,5 +14,6 @@ __PACKAGE__->add_attributes( __PACKAGE__->has_many('children', 'Foo::Child', 'domainId'); __PACKAGE__->belongs_to('parent', 'Foo::Parent', 'parentId'); + 1; diff --git a/author.t/lib/Foo/Parent.pm b/author.t/lib/Foo/Parent.pm index 0e05c4c..6c871cb 100644 --- a/author.t/lib/Foo/Parent.pm +++ b/author.t/lib/Foo/Parent.pm @@ -1,9 +1,9 @@ package Foo::Parent; use Moose; -extends 'SimpleDB::Class::Domain'; +extends 'SimpleDB::Class::Item'; -__PACKAGE__->set_name('foo_parent'); +__PACKAGE__->set_domain_name('foo_parent'); __PACKAGE__->add_attributes(title=>{isa=>'Str'}); __PACKAGE__->has_many('domains', 'Foo::Domain', 'parentId'); diff --git a/dist.ini b/dist.ini index 9051b30..0c297b3 100644 --- a/dist.ini +++ b/dist.ini @@ -1,5 +1,5 @@ name = SimpleDB-Class -version = 0.0201 +version = 0.0300 author = JT Smith license = Perl_5 copyright_holder = Plain Black Corporation @@ -13,6 +13,7 @@ DateTime = 0 DateTime::Format::Strptime = 0 Moose = 0.93 MooseX::ClassAttribute = 0 +Sub::Name = 0.04 Digest::SHA = 0 XML::Simple = 0 URI = 0 diff --git a/lib/SimpleDB/Class.pm b/lib/SimpleDB/Class.pm index 71922cc..ca4fe08 100644 --- a/lib/SimpleDB/Class.pm +++ b/lib/SimpleDB/Class.pm @@ -15,12 +15,12 @@ SimpleDB::Class - An Object Relational Mapper (ORM) for the Amazon SimpleDB serv 1; - package Library::Books; + package Library::Book; use Moose; - extends 'SimpleDB::Class::Domain'; + extends 'SimpleDB::Class::Item'; - __PACKAGE__->set_name('books'); + __PACKAGE__->set_domain_name('book'); __PACKAGE__->add_attributes({ title => { isa => 'Str', default => 'Untitled' }, publish_date => { isa => 'Date' }, @@ -29,20 +29,20 @@ SimpleDB::Class - An Object Relational Mapper (ORM) for the Amazon SimpleDB serv publisherId => { isa => 'Str' }, author => { isa => 'Str' }, }); - __PACKAGE__->belongs_to('publisher', 'Library::Publishers', 'publisherId'); + __PACKAGE__->belongs_to('publisher', 'Library::Publisher', 'publisherId'); 1; - package Library::Publishers; + package Library::Publisher; use Moose; - extends 'SimpleDB::Class::Domain'; + extends 'SimpleDB::Class::Item'; - __PACKAGE__->set_name('publishers'); + __PACKAGE__->set_domain_name('publisher'); __PACKAGE__->add_attributes({ name => { isa => 'Str' }, }); - __PACKAGE__->has_many('books', 'Library::Books', 'publisherId'); + __PACKAGE__->has_many('books', 'Library::Book', 'publisherId'); 1; @@ -52,10 +52,10 @@ SimpleDB::Class - An Object Relational Mapper (ORM) for the Amazon SimpleDB serv my $library = Library->new(access_key => 'xxx', secret_key => 'yyy', cache_servers=>\@servers ); - my $specific_book = $library->domain('books')->find('id goes here'); + my $specific_book = $library->domain('book')->find('id goes here'); - my $books = $library->domain('publishers')->books; - my $books = $library->domain('books')->search({publish_date => DateTime->new(year=>2001)}); + my $books = $library->domain('publisher')->books; + my $books = $library->domain('book')->search({publish_date => DateTime->new(year=>2001)}); while (my $book = $books->next) { say $book->title; } @@ -120,6 +120,7 @@ use Moose; use MooseX::ClassAttribute; use SimpleDB::Class::Cache; use SimpleDB::Class::HTTP; +use SimpleDB::Class::Domain; use Module::Find; #-------------------------------------------------------- @@ -138,10 +139,32 @@ The access key given to you from Amazon when you sign up for the SimpleDB servic The secret access key given to you from Amazon. +=head4 cache_servers + +An array reference of cache servers. See L for details. + =cut #-------------------------------------------------------- +=head2 load_namespaces ( [ namespace ] ) + +Class method. Loads all the modules in the current namespace, so if you subclass SimpleDB::Class with a package called Library (as in the example provided), then everything in the Library namespace would be loaded automatically. Should be called to load all the modules you subclass, so you don't have to manually use each of them. + +=head3 namespace + +Specify a specific namespace like Library::SimpleDB if you don't want everything in the Library namespace to be loaded. + +=cut + +sub load_namespaces { + my ($class, $namespace) = @_; + $namespace ||= $class; # if no namespace is set + useall $namespace; +} + +#-------------------------------------------------------- + =head2 cache_servers ( ) Returns the cache server array reference passed into the constructor. @@ -230,103 +253,22 @@ class_has 'domain_names' => ( #-------------------------------------------------------- -=head2 domain_classes ( [ list ] ) - -Class method. Returns a hashref of the domain class names and instances registered from subclassing L and calling set_name. - -=cut - -class_has 'domain_instances' => ( - is => 'rw', - default => sub{{}}, -); - -#-------------------------------------------------------- - -=head2 load_namespaces ( [ namespace ] ) - -Class method. Loads all the modules in the current namespace, so if you subclass SimpleDB::Class with a package called Library (as in the example provided), then everything in the Library namespace would be loaded automatically. Should be called to load all the modules you subclass, so you don't have to manually use each of them. - -=head3 namespace - -Specify a specific namespace like Library::SimpleDB if you don't want everything in the Library namespace to be loaded. - -=cut - -sub load_namespaces { - my ($class, $namespace) = @_; - $namespace ||= $class; # if no namespace is set - useall $namespace; -} - -#-------------------------------------------------------- -sub _add_domain { - my ($class, $name, $object) = @_; - my $classname = ref $object; - my $names = $class->domain_names; - $names->{$name} = $classname; - __PACKAGE__->domain_names($names); - my $instances = $class->domain_instances; - $instances->{$classname} = $object; - __PACKAGE__->domain_instances($instances); - return $names; -} - -#-------------------------------------------------------- - -=head2 determine_domain_class ( moniker ) - -Given a domain name or class name, returns the class name associated with it. - -=head2 moniker - -A class name or a domain name that is a subclass of L. In the above example Library::Books or books would both return Library::Books. - -=cut - -sub determine_domain_class { - my ($self, $moniker) = @_; - my $class = $self->domain_names->{$moniker}; - unless ($class) { - $class = $moniker; - } - return $class; -} - -#-------------------------------------------------------- - -=head2 determine_domain_instance ( classname ) - -Returns an instanciated L based upon it's class name. - -=head3 classname - -The classname to fetch an instance for. In the above example, Library::Books or Library::Publishers would both work. - -=cut - -sub determine_domain_instance { - my ($self, $classname) = @_; - my $domain = $self->domain_instances->{$classname}; - $domain->simpledb($self); - return $domain; -} - -#-------------------------------------------------------- - =head2 domain ( moniker ) -Returns an instanciated L based upon it's classname or domain name. +Returns an instanciated L based upon its L classname or its domain name. =head3 moniker -See determine_domain_class() for details. +Can either be the L subclass name, or the domain name. =cut sub domain { my ($self, $moniker) = @_; - return $self->determine_domain_instance($self->determine_domain_class($moniker)); + my $class = $self->domain_names->{$moniker}; + $class ||= $moniker; + my $d = SimpleDB::Class::Domain->new(simpledb=>$self, item_class=>$class); + return $d; } #-------------------------------------------------------- @@ -354,6 +296,7 @@ This package requires the following modules: L L L +L L L L diff --git a/lib/SimpleDB/Class/Domain.pm b/lib/SimpleDB/Class/Domain.pm index 9f2e2e7..a0712d0 100644 --- a/lib/SimpleDB/Class/Domain.pm +++ b/lib/SimpleDB/Class/Domain.pm @@ -15,7 +15,6 @@ The following methods are available from this class. =cut use Moose; -use SimpleDB::Class::Item; use SimpleDB::Class::SQL; use SimpleDB::Class::ResultSet; use SimpleDB::Class::Exception; @@ -44,180 +43,49 @@ Required. The SimpleDB domain name associated with this class. #-------------------------------------------------------- -=head2 set_name ( name ) +=head2 item_class ( ) -Class method. Used to set the SimpleDB domain name associated with a sublcass. - -=head3 name - -The domain name to set. - -=cut - -sub set_name { - my ($class, $name) = @_; - SimpleDB::Class->_add_domain($name => $class->new(name=>$name)); -} - -#-------------------------------------------------------- - -=head2 name ( ) - -Returns the name set in the constructor. +Returns the L subclass name passed into the constructor. =cut -has 'name' => ( +has item_class => ( is => 'ro', required => 1, + trigger => sub { + my ($self, $item, $old) = @_; + $self->name($item->domain_name); + }, ); #-------------------------------------------------------- -=head2 simpledb ( ) +=head2 name ( ) -Returns the L object set in the constructor. +Returns the name determined automatically by the item_class passed into the constructor. =cut -has 'simpledb' => ( +has name => ( is => 'rw', + default => undef, ); #-------------------------------------------------------- -=head2 attributes ( ) - -Returns the hashref of attributes set by the add_attributes() method. - -=cut - -has 'attributes' => ( - is => 'rw', - isa => 'HashRef', - default => sub{{}}, -); - -#-------------------------------------------------------- - -=head2 parents ( ) - -Returns the hashref of parents set by the belongs_to() method. - -=cut - -has 'parents' => ( - is => 'rw', - isa => 'HashRef', - default => sub{{}}, -); - -#-------------------------------------------------------- - -=head2 children ( ) +=head2 simpledb ( ) -Returns the hashref of children set by the has_many() method. +Returns the L object set in the constructor. =cut -has children => ( - is => 'rw', - isa => 'HashRef', - default => sub{{}}, +has simpledb => ( + is => 'ro', + required => 1, ); #-------------------------------------------------------- -=head2 belongs_to ( method, class, attribute ) - -Class method. Adds a 1:N relationship between another class and this one. - -=head3 method - -The method name to create to represent this relationship in this class. - -=head3 class - -The class name of the parent class you're relating this class to. - -=head3 attribute - -The attribute in this class' attribute list that represents the id of the parent class. - -=cut - -sub belongs_to { - my ($class, $name, $classname, $attribute) = @_; - my $self = SimpleDB::Class->determine_domain_instance($class); - my $parents = $self->parents; - $parents->{$name} = [$classname, $attribute]; - $self->parents($parents); -}; - -#-------------------------------------------------------- - -=head2 has_many ( method, class, attribute ) - -Class method. Sets up a 1:N relationship between this class and a child class. - -WARNING: With this method you need to be aware that SimpleDB is eventually consistent. See L for details. - -=head3 method - -The name of the method in this class you wish to use to access the relationship with the child class. - -=head3 class - -The class name of the class you're creating the child relationship with. - -=head3 attribute - -The attribute in the child class that represents this class' id. - -=cut - -sub has_many { - my ($class, $name, $classname, $attribute) = @_; - my $self = SimpleDB::Class->determine_domain_instance($class); - my $children = $self->children; - $children->{$name} = [$classname, $attribute]; - $self->children($children); -}; - -#-------------------------------------------------------- - -=head2 add_attributes ( list ) - -Class method. Adds more attributes to this class. - -=head3 list - -A hashref that holds a list of attributes and their properties (a hashref itself). Example: title => { isa => 'Str', default => 'Untitled' } - -=head4 attribute - -The attribute name is key in the hashref. - -=head4 isa - -The type of data represented by this attribute. Defaults to 'Str' if left out. Options are 'Str', 'Int', and 'DateTime'. - -=head4 default - -The default value for this attribute. This should be specified even if it is 'None' or 'Undefined' or 'Null', because actuall null queries are slow in SimpleDB. - -=cut - -sub add_attributes { - my ($class, %new_attributes) = @_; - my $self = SimpleDB::Class->determine_domain_instance($class); - my %attributes = (%{$self->attributes}, %new_attributes); - $self->attributes(\%attributes); - return \%attributes; -} - -#-------------------------------------------------------- - =head2 create Creates this domain in the SimpleDB. @@ -268,7 +136,9 @@ sub find { ItemName => $id, DomainName => $self->name, }); - my $item = SimpleDB::Class::ResultSet->new(domain=>$self)->handle_item($id, $result->{GetAttributesResult}{Attribute}); + my $item = SimpleDB::Class::ResultSet + ->new(simpledb=>$self->simpledb, item_class=>$self->item_class) + ->handle_item($id, $result->{GetAttributesResult}{Attribute}); $cache->set($self->name, $id, $item->to_hashref); return $item; } @@ -277,7 +147,8 @@ sub find { return $e->rethrow; } elsif (defined $attributes) { - return SimpleDB::Class::Item->new(id=>$id, domain=>$self, attributes=>$attributes); + return $self->item_class->new(id=>$id, simpledb=>$self->simpledb) + ->update($attributes); } else { SimpleDB::Class::Exception->throw(error=>"An undefined error occured while fetching the item."); @@ -302,13 +173,13 @@ Optionally specify a unqiue id for this item. sub insert { my ($self, $attributes, $id) = @_; - my %params = (domain=>$self, attributes=>$attributes); + my %params = (simpledb=>$self->simpledb); if (defined $id && $id ne '') { $params{id} = $id; } - my $item = SimpleDB::Class::Item->new(\%params); - $item->put; - return $item; + return $self->item_class->new(\%params) + ->update($attributes) + ->put; } #-------------------------------------------------------- @@ -328,7 +199,7 @@ A where clause as defined in L if you want to count only a sub count { my ($self, $clauses) = @_; my $select = SimpleDB::Class::SQL->new( - domain => $self, + item_class => $self->item_class, where => $clauses, output => 'count(*)', ); @@ -355,7 +226,8 @@ A where clause as defined by L. sub search { my ($self, $where) = @_; return SimpleDB::Class::ResultSet->new( - domain => $self, + simpledb => $self->simpledb, + item_class => $self->item_class, where => $where, ); } diff --git a/lib/SimpleDB/Class/Item.pm b/lib/SimpleDB/Class/Item.pm index 8d052a1..ff32049 100644 --- a/lib/SimpleDB/Class/Item.pm +++ b/lib/SimpleDB/Class/Item.pm @@ -17,163 +17,229 @@ The following methods are available from this class. use Moose; use UUID::Tiny; use SimpleDB::Class::SQL; +use Sub::Name (); #-------------------------------------------------------- +sub _install_sub { + my ($name, $sub) = @_; + no strict 'refs'; + *{$name} = Sub::Name::subname($name, $sub); +} -=head2 new ( params ) +#-------------------------------------------------------- -Constructor. +=head2 set_domain_name ( name ) -=head3 params +Class method. Used to set the SimpleDB domain name associated with a sublcass. -A hash. +=head3 name -=head4 id +The domain name to set. -The unique identifier (ItemName) of the item represented by this class. If you don't pass this in, an item ID will be generated for you automatically. +=head2 domain_name ( ) -=head4 domain +After set_domain_name() has been called, there will be a domain_name method, that will return the value of the domain name. -Required. A L object. +=cut -=head4 attributes +sub set_domain_name { + my ($class, $name) = @_; + # inject domain_name sub + _install_sub($class.'::domain_name', sub { return $name }); + # register the name and class with the schema + my $names = SimpleDB::Class->domain_names; + $names->{$name} = $class; + SimpleDB::Class->domain_names($names); +} -Required. A hashref containing the names and values of the attributes associated with this item. +#-------------------------------------------------------- -=head2 {attribute} ( [ value ] ) +=head2 add_attributes ( list ) -For each attribute passed into the constructor, an accessor / mutator will be added to this class allowing you to get or set it's current value. +Class method. Adds more attributes to this class. B This will add a method to your class which can be used as an accessor/mutator. Therefore make sure to avoid method name conflicts with this class. -=head3 +=head3 list -If specified, sets the current value of the attribute. Note, that this doesn't update the database, for that you must call the put() method. +A hashref that holds a list of attributes and their properties (a hashref itself). Example: title => { isa => 'Str', default => 'Untitled' } -=cut +=head4 attribute -#-------------------------------------------------------- +The attribute name is key in the hashref. -=head2 id ( ) +=head4 isa -Returns the unique id of this item. +The type of data represented by this attribute. Defaults to 'Str' if left out. Options are 'Str', 'Int', and 'DateTime'. + +=head4 default + +The default value for this attribute. This should be specified even if it is 'None' or 'Undefined' or 'Null', because actuall null queries are slow in SimpleDB. =cut -has id => ( - is => 'ro', - builder => 'generate_uuid', - lazy => 1, +sub add_attributes { + my ($class, %attributes) = @_; + foreach my $name (keys %attributes) { + my $accessor = sub { + my ($self, $val) = @_; + my $attr = $self->attribute_data; + if (defined $val) { + $attr->{$name} = $val; + $self->attribute_data($attr); + } + return $attr->{$name}; + }; + _install_sub($class.'::'.$name, $accessor); + } + my %new = (%{$class->attributes}, %attributes); + _install_sub($class.'::attributes', sub { return \%new; }); +} + +has attribute_data => ( + is => 'rw', + default => sub {{}}, ); #-------------------------------------------------------- -=head2 domain ( ) +=head2 has_many ( method, class, attribute ) + +Class method. Sets up a 1:N relationship between this class and a child class. + +WARNING: With this method you need to be aware that SimpleDB is eventually consistent. See L for details. + +=head3 method + +The name of the method in this class you wish to use to access the relationship with the child class. -Returns the domain passed into the constructor. +=head3 class + +The class name of the class you're creating the child relationship with. + +=head3 attribute + +The attribute in the child class that represents this class' id. =cut -has domain => ( - is => 'ro', - required => 1, -); +sub has_many { + my ($class, $name, $classname, $attribute) = @_; + _install_sub($class.'::'.$name, sub { my $self = shift; return $self->simpledb->domain($classname)->search({$attribute => $self->id}); }); +} #-------------------------------------------------------- -=head2 attributes ( ) +=head2 belongs_to ( method, class, attribute ) + +Class method. Adds a 1:N relationship between another class and this one. + +=head3 method + +The method name to create to represent this relationship in this class. + +=head3 class + +The class name of the parent class you're relating this class to. + +=head3 attribute -Returns the attributes passed into the constructor. +The attribute in this class' attribute list that represents the id of the parent class. =cut -has attributes => ( - is => 'rw', - isa => 'HashRef', - required => 1, -); +sub belongs_to { + my ($class, $name, $classname, $attribute) = @_; + _install_sub($class.'::'.$name, sub { my $self = shift; return $self->simpledb->domain($classname)->find($self->$attribute); }); +}; #-------------------------------------------------------- -=head2 add_attribute ( name, [ default, type ] ) +=head2 attributes ( ) -Adds an accessor / mutator for a new attribute. Allows you to create a wide range of items with a wide range of attributes that weren't conceived when you wrote the domain object. +Class method. Returns the hashref of attributes set by the add_attributes() method. + +=cut +sub attributes { return {} }; -=head3 name -The attribute name. +#-------------------------------------------------------- -=head3 default +=head2 update ( attributes ) -The default value. Defaults to undef, which is bad because null searches are slow. +Update a bunch of attributes all at once. Returns a reference to L<$self> so it can be chained into other methods. -=head3 type +=head3 attributes -Valid types are 'Str', 'Int', and 'DateTime'. Defaults to 'Str'. +A hash reference containing attribute names and values. =cut -sub add_attribute { - my ($self, $name, $value) = @_; - my $attributes = $self->attributes; - $attributes->{$name} = $value; - $self->attributes($attributes); - has $name => ( - is => 'rw', - default => $value, - lazy => 1, - ); +sub update { + my ($self, $attributes) = @_; + foreach my $attribute (keys %{$attributes}) { + $self->$attribute($attributes->{$attribute}); + } + return $self; } + +#-------------------------------------------------------- + +=head2 new ( params ) + +Constructor. + +=head3 params + +A hash. + +=head4 id + +The unique identifier (ItemName) of the item represented by this class. If you don't pass this in, an item ID will be generated for you automatically. + +=head4 simpledb + +Required. A L object. + +=head4 attributes + +Required. A hashref containing the names and values of the attributes associated with this item. + +=head2 {attribute} ( [ value ] ) + +For each attribute passed into the constructor, an accessor / mutator will be added to this class allowing you to get or set it's current value. + +=head3 + +If specified, sets the current value of the attribute. Note, that this doesn't update the database, for that you must call the put() method. + +=cut + #-------------------------------------------------------- -=head2 BUILD ( ) +=head2 simpledb ( ) -Generates the relationship methods and attribute methods on object construction. See L for details. +Returns the simpledb passed into the constructor. =cut -sub BUILD { - my ($self) = @_; - my $domain = $self->domain; - my $simpledb = $domain->simpledb; +has simpledb => ( + is => 'ro', + required => 1, +); - # add attributes - my $registered_attributes = $domain->attributes; - my $attributes = $self->attributes; - my $select = SimpleDB::Class::SQL->new(domain=>$domain); - foreach my $name (keys %{$attributes}) { - my %params = ( - is => 'rw', - default => $select->parse_value($name, $attributes->{$name}), - lazy => 1, - ); - if (exists $registered_attributes->{$name}{isa}) { - $params{isa} = $registered_attributes->{$name}{isa}; - } - has $name => (%params); - } +#-------------------------------------------------------- - # add parents - my $parents = $domain->parents; - foreach my $parent (keys %{$parents}) { - my ($classname, $attribute) = @{$parents->{$parent}}; - has $parent => ( - is => 'ro', - default => sub { return $simpledb->determine_domain_instance($classname)->find($self->$attribute); }, - lazy => 1, - ); - } +=head2 id ( ) - # add children - my $children = $domain->children; - foreach my $child (keys %{$children}) { - my ($classname, $attribute) = @{$children->{$child}}; - has $child => ( - is => 'ro', - default => sub { return $simpledb->determine_domain_instance($classname)->search({$attribute => $self->id}); }, - lazy => 1, - ); - } -} +Returns the unique id of this item. + +=cut + +has id => ( + is => 'ro', + builder => 'generate_uuid', + lazy => 1, +); #-------------------------------------------------------- @@ -193,7 +259,7 @@ sub copy { foreach my $name (keys %{$self->attributes}) { $properties{$name} = $self->$name; } - my $new = $self->new(domain => $self->domain, attributes => \%properties, id=>$id); + my $new = $self->new(simpledb => $self->simpledb, attributes => \%properties, id=>$id); $new->put; return $new; } @@ -208,10 +274,9 @@ Removes this item from the database. sub delete { my ($self) = @_; - my $domain = $self->domain; - my $simpledb = $domain->simpledb; - eval{$simpledb->cache->delete($domain->name, $self->id)}; - $simpledb->http->send_request('DeleteAttributes', {ItemName => $self->id, DomainName=>$domain->name}); + my $simpledb = $self->simpledb; + eval{$simpledb->cache->delete($self->domain_name, $self->id)}; + $simpledb->http->send_request('DeleteAttributes', {ItemName => $self->id, DomainName=>$self->domain_name}); } #-------------------------------------------------------- @@ -227,10 +292,9 @@ sub delete_attribute { my $attributes = $self->attributes; delete $attributes->{$name}; $self->attributes($attributes); - my $domain = $self->domain; - my $simpledb = $domain->simpledb; - eval{$simpledb->cache->set($domain->name, $self->id, $attributes)}; - $simpledb->http->send_request('DeleteAttributes', { ItemName => $self->id, DomainName => $domain->name, 'Attribute.0.Name' => $name } ); + my $simpledb = $self->simpledb; + eval{$simpledb->cache->set($self->domain_name, $self->id, $attributes)}; + $simpledb->http->send_request('DeleteAttributes', { ItemName => $self->id, DomainName => $self->domain_name, 'Attribute.0.Name' => $name } ); } #-------------------------------------------------------- @@ -249,20 +313,19 @@ sub generate_uuid { =head2 put ( ) -Inserts/updates the current attributes of this Item object to the database. +Inserts/updates the current attributes of this Item object to the database. Returns a reference to L<$self> so it can be chained into other methods. =cut sub put { my ($self) = @_; - my $domain = $self->domain; - my $params = {ItemName => $self->id, DomainName=>$domain->name}; + my $params = {ItemName => $self->id, DomainName=>$self->domain_name}; my $i = 0; - my $select = SimpleDB::Class::SQL->new(domain=>$domain); - my $simpledb = $domain->simpledb; + my $select = SimpleDB::Class::SQL->new(item_class=>ref($self)); my $attributes = $self->to_hashref; foreach my $name (keys %{$attributes}) { my $values = $attributes->{$name}; + next unless defined $values; # don't store null values unless ($values eq 'ARRAY') { $values = [$values]; } @@ -273,8 +336,10 @@ sub put { $i++; } } - eval{$simpledb->cache->set($domain->name, $self->id, $attributes)}; + my $simpledb = $self->simpledb; + eval{$simpledb->cache->set($self->domain_name, $self->id, $attributes)}; $simpledb->http->send_request('PutAttributes', $params); + return $self; } #-------------------------------------------------------- diff --git a/lib/SimpleDB/Class/ResultSet.pm b/lib/SimpleDB/Class/ResultSet.pm index 68e3980..21338d5 100644 --- a/lib/SimpleDB/Class/ResultSet.pm +++ b/lib/SimpleDB/Class/ResultSet.pm @@ -16,7 +16,6 @@ The following methods are available from this class. use Moose; use SimpleDB::Class::SQL; -use SimpleDB::Class::Item; #-------------------------------------------------------- @@ -28,9 +27,13 @@ Constructor. A hash. -=head4 domain +=head4 simpledb -Required. A L object. +Required. A L object. + +=head4 item_class + +Required. A L subclass name. =head4 result @@ -57,13 +60,26 @@ has where => ( #-------------------------------------------------------- -=head2 domain ( ) +=head2 simpledb ( ) + +Returns the simpledb passed into the constructor. + +=cut + +has simpledb => ( + is => 'ro', + required => 1, +); + +#-------------------------------------------------------- + +=head2 item_class ( ) -Returns the domain passed into the constructor. +Returns the item_class passed into the constructor. =cut -has domain => ( +has item_class => ( is => 'ro', required => 1, ); @@ -113,7 +129,7 @@ Fetches a result, based on a where clause passed into a constructor, and then ma sub fetch_result { my ($self) = @_; my $select = SimpleDB::Class::SQL->new( - domain => $self->domain, + item_class => $self->item_class, where => $self->where, ); my %params = (SelectExpression => $select->to_sql); @@ -123,7 +139,7 @@ sub fetch_result { $params{NextToken} = $self->result->{SelectResult}{NextToken}; } - my $result = $self->domain->simpledb->http->send_request('Select', \%params); + my $result = $self->simpledb->http->send_request('Select', \%params); $self->result($result); return $result; } @@ -138,7 +154,6 @@ Returns the next result in the result set. Also fetches th next partial result s sub next { my ($self) = @_; - # get the current results my $result = ($self->has_result) ? $self->result : $self->fetch_result; my $items = (ref $result->{SelectResult}{Item} eq 'ARRAY') ? $result->{SelectResult}{Item} : [$result->{SelectResult}{Item}]; @@ -165,15 +180,14 @@ sub next { $self->iterator($iterator); # make the item object - my $domain = $self->domain; - my $cache = $domain->simpledb->cache; + my $cache = $self->simpledb->cache; ## fetch from cache even though we've already pulled it back from the db, because the one in cache ## might be more up to date than the one from the DB - my $attributes = eval{$cache->get($domain->name, $item->{Name})}; + my $attributes = eval{$cache->get($self->item_class->domain_name, $item->{Name})}; my $e; if ($e = SimpleDB::Class::Exception::ObjectNotFound->caught) { my $itemobj = $self->handle_item($item->{Name}, $item->{Attribute}); - eval{$cache->set($domain->name, $item->{Name}, $itemobj->to_hashref)}; + eval{$cache->set($self->item_class->domain_name, $item->{Name}, $itemobj->to_hashref)}; return $itemobj; } elsif ($e = SimpleDB::Class::Exception->caught) { @@ -181,7 +195,7 @@ sub next { return $e->rethrow; } elsif (defined $attributes) { - return SimpleDB::Class::Item->new(id=>$item->{Name}, domain=>$domain, attributes=>$attributes); + return $self->item_class->new(id=>$item->{Name}, simpledb=>$self->simpledb)->update($attributes); } else { SimpleDB::Class::Exception->throw(error=>"An undefined error occured while fetching the item from cache."); @@ -198,27 +212,39 @@ Converts the attributes section of an item in a result set into a Ldomain; - my $attributes = {}; - my $registered_attributes = $domain->attributes; unless (ref $list eq 'ARRAY') { $list = [$list]; } - my $select = SimpleDB::Class::SQL->new(domain=>$self->domain); + my $item = $self->item_class->new(simpledb=>$self->simpledb, name=>$id); + my $attributes = {}; + my $registered_attributes = $self->item_class->attributes; + my $select = SimpleDB::Class::SQL->new(item_class=>$self->item_class); + my %added = (); foreach my $attribute (@{$list}) { - my $value = $select->parse_value($attribute->{Name}, $attribute->{Value}); + my $name = $attribute->{Name}; + + # add unknown attributes + if (!exists $registered_attributes->{$name} && ! exists $added{$name}) { + $item->add_attributes($name => { isa => 'Str' }); + $added{$name} = 1; + } + + # get value + my $value = $select->parse_value($name, $attribute->{Value}); + # create expected hashref - if (exists $attributes->{$attribute->{Name}}) { - if (ref $attributes->{$attribute->{Name}} ne 'ARRAY') { - $attributes->{$attribute->{Name}} = [$attributes->{$attribute->{Name}}]; + if (exists $attributes->{$name}) { + if (ref $attributes->{$name} ne 'ARRAY') { + $attributes->{$name} = [$attributes->{$name}]; } - push @{$attributes->{$attribute->{Name}}}, $value; + push @{$attributes->{$name}}, $value; } else { - $attributes->{$attribute->{Name}} = $value; + $attributes->{$name} = $value; } + } - return SimpleDB::Class::Item->new(domain=>$domain, name=>$id, attributes=>$attributes); + return $item->update($attributes); } =head1 LEGAL diff --git a/lib/SimpleDB/Class/SQL.pm b/lib/SimpleDB/Class/SQL.pm index e237618..8ad4a7f 100644 --- a/lib/SimpleDB/Class/SQL.pm +++ b/lib/SimpleDB/Class/SQL.pm @@ -28,9 +28,9 @@ Constructor. A hash of options you can pass in to the constructor. -=head4 domain +=head4 item_class -A L object. This is required. +A L subclass name. This is required. =head4 output @@ -120,20 +120,20 @@ Returns what was passed into the constructor for the output field. =cut -has 'output' => ( +has output => ( is => 'ro', default => '*', ); #-------------------------------------------------------- -=head2 domain () +=head2 item_class () -Returns what was passed into the constructor for the domain field. +Returns what was passed into the constructor for the item_class field. =cut -has 'domain' => ( +has item_class => ( is => 'ro', required => 1, ); @@ -150,7 +150,7 @@ Returns a boolean indicating whether a where clause has been set. =cut -has 'where' => ( +has where => ( is => 'ro', predicate => 'has_where', ); @@ -167,7 +167,7 @@ Returns a boolean indicating whether an order by clause has been set. =cut -has 'order_by' => ( +has order_by => ( is => 'ro', predicate => 'has_order_by', ); @@ -182,7 +182,7 @@ Returns what was passed into the constructor for the output field. =cut -has 'limit' => ( +has limit => ( is => 'ro', predicate => 'has_limit', ); @@ -238,7 +238,12 @@ A string in the format of YY-MM-DD HH:MM:SS NNNNNNN +ZZZZ where NNNNNNN represen sub parse_datetime { my ($self, $value) = @_; - return DateTime::Format::Strptime::strptime('%Y-%m-%d %H:%M:%S %N %z',$value) || DateTime->now; + if ($value =~ m/\d{4}-\d\d-\d\d \d\d:\d\d:\d\d \d+ +\d{4}/) { + return DateTime::Format::Strptime::strptime('%Y-%m-%d %H:%M:%S %N %z',$value); + } + else { + return DateTime->now; + } } #-------------------------------------------------------- @@ -255,6 +260,7 @@ A string that is composed of an integer + 1000000000 and then padded to have pre sub parse_int { my ($self, $value) = @_; + $value ||= 0; return $value-1000000000; } @@ -276,9 +282,9 @@ The current stringified value to parse. sub parse_value { my ($self, $name, $value) = @_; - my $registered_attributes = $self->domain->attributes; + my $registered_attributes = $self->item_class->attributes; # set default value - $value ||= $registered_attributes->{$name}; + $value ||= $registered_attributes->{$name}{default}; # find isa my $isa = $registered_attributes->{$name}{isa} || ''; # pad integers @@ -306,6 +312,7 @@ A L object. sub format_datetime { my ($self, $value) = @_; + $value ||= DateTime->now; return DateTime::Format::Strptime::strftime('%Y-%m-%d %H:%M:%S %N %z',$value); } @@ -348,9 +355,9 @@ A boolean indicating whether or not to skip calling the quote_value function on sub format_value { my ($self, $name, $value, $skip_quotes) = @_; - my $registered_attributes = $self->domain->attributes; + my $registered_attributes = $self->item_class->attributes; # set default value - $value ||= $registered_attributes->{$name}; + $value ||= $registered_attributes->{$name}{default}; # find isa my $isa = $registered_attributes->{$name}{isa} || ''; # pad integers @@ -498,7 +505,7 @@ sub to_sql { $limit = ' limit '.$self->limit; } - return 'select '.$output.' from '.$self->quote_attribute($self->domain->name).$where.$sort.$limit; + return 'select '.$output.' from '.$self->quote_attribute($self->item_class->can('domain_name')->()).$where.$sort.$limit; } diff --git a/t/03.Class.t b/t/03.Class.t index 0c09d56..bec8e92 100644 --- a/t/03.Class.t +++ b/t/03.Class.t @@ -1,16 +1,54 @@ -use Test::More tests => 4; +use Test::More tests => 19; +use Test::Deep; use lib '../lib'; +diag( "Testing SimpleDB::Class $SimpleDB::Class::VERSION" ); +use_ok( 'SimpleDB::Class::Exception'); use_ok( 'SimpleDB::Class' ); -diag( "Testing SimpleDB::Class $SimpleDB::Class::VERSION" ); - my $db = SimpleDB::Class->new(secret_key=>'secretxx', access_key=>'accessyy', cache_servers=>[{'socket' => '/tmp/foo/bar'}]); isa_ok($db, 'SimpleDB::Class'); isa_ok($db->cache, 'SimpleDB::Class::Cache'); isa_ok($db->http, 'SimpleDB::Class::HTTP'); +use_ok( 'SimpleDB::Class::SQL'); +use_ok( 'SimpleDB::Class::ResultSet'); +use_ok( 'SimpleDB::Class::Domain' ); +use_ok( 'SimpleDB::Class::Item' ); + +SimpleDB::Class::Item->set_domain_name('test'); + +my %attributes = ( + 'xxx'=>{ isa => 'Str'}, + 'foo'=> { isa => 'Str', default=>'abc'}, + 'bar'=>{ isa => 'Int', default=>24}, + ); +SimpleDB::Class::Item->add_attributes(%attributes); +cmp_deeply(SimpleDB::Class::Item->attributes, \%attributes, 'setting attributes works'); +$attributes{this} = {isa => 'Str'}; +SimpleDB::Class::Item->add_attributes(this => { isa => 'Str' } ); +cmp_deeply(SimpleDB::Class::Item->attributes, \%attributes, 'adding attributes works'); + + +my $domain = $db->domain('SimpleDB::Class::Item'); +isa_ok($domain, 'SimpleDB::Class::Domain'); + +is($domain->name, 'test', 'domain name assignment works'); +is($domain->item_class, 'SimpleDB::Class::Item', 'item_class'); + +my $item = SimpleDB::Class::Item->new(simpledb=>$db, id=>1); +isa_ok($item, 'SimpleDB::Class::Item'); +ok($item->can('foo'), 'attributes create accessors'); +$item->foo('11'); +is($item->foo, 11, 'can set added accessor'); + +SimpleDB::Class::Item->has_many('many', 'XXX', 'x'); +ok($item->can('many'), 'has_many creates a method'); + +SimpleDB::Class::Item->belongs_to('belongs', 'XXX', 'x'); +ok($item->can('belongs'), 'belongs_to creates a method'); + # everything else requires a connection diff --git a/t/05.Domain.t b/t/05.Domain.t deleted file mode 100644 index 0ed2eb8..0000000 --- a/t/05.Domain.t +++ /dev/null @@ -1,24 +0,0 @@ -use Test::More tests => 3; -use Test::Deep; -use lib '../lib'; - -use SimpleDB::Class; -use_ok( 'SimpleDB::Class::Domain' ); - -my %attributes = ('foo'=>{}, 'bar'=>{}, 'xxx'=>{}); - -SimpleDB::Class::Domain->set_name('test'); -my $db = SimpleDB::Class->new(access_key=>'access', secret_key=>'secret', cache_servers=>[{host=>'127.0.0.1',port=>11211}]); - -my $domain = $db->domain('SimpleDB::Class::Domain'); -is($domain->name, 'test', 'domain name assignment works'); - -SimpleDB::Class::Domain->add_attributes(%attributes); -cmp_deeply( - $domain->attributes, - \%attributes, - 'attributes work' -); - - -# everything else requires a connection diff --git a/t/07.Item.t b/t/07.Item.t deleted file mode 100644 index 6548448..0000000 --- a/t/07.Item.t +++ /dev/null @@ -1,38 +0,0 @@ -use Test::More tests => 7; -use Test::Deep; -use lib '../lib'; -use SimpleDB::Class; -use SimpleDB::Class::Domain; -use_ok( 'SimpleDB::Class::Item' ); - -my %attributes = ('foo' => 'xxx'); - - -my $db = SimpleDB::Class->new(secret_key=>'secretxx', access_key=>'accessyy', cache_servers=>[{host=>'127.0.0.1',port=>11211}]); -my $domain = SimpleDB::Class::Domain->new(name=>'test', simpledb=>$db); -my $item = SimpleDB::Class::Item->new(domain=>$domain, attributes=>\%attributes); - -isa_ok($item, 'SimpleDB::Class::Item'); - -cmp_deeply( - $item->attributes, - \%attributes, - 'attributes work' -); - -ok($item->can('foo'), 'attributes create accessors'); - -$item->add_attribute('bar',2); -$attributes->{bar} = 2; - -cmp_deeply( - $item->attributes, - \%attributes, - 'new attributes work' -); - -ok($item->can('bar'), 'new attributes create accessors'); - -like($item->generate_uuid, qr/^[a-z0-9\-]+$/, 'UUID generator working'); - -# everything else requires a connection