gistfile1.diff

 Entity/Artist.pm              |   13 +++++++
 Role/DataQuality.pm           |    9 +++++
 Role/Editable.pm              |    9 +++++
 Role/GID.pm                   |   10 ++++++
 Role/ID.pm                    |    9 +++++
 Role/Name.pm                  |   10 ++++++
 Role/SortName.pm              |    9 +++++
 Storage/Artist.pm             |   69 ++++++++++++++++++++++++++++++++++++++++
 Storage/Role/CacheAccessor.pm |   70 +++++++++++++++++++++++++++++++++++++++++
 Storage/Role/Memcached.pm     |   13 +++++++
 Storage/Role/ProcessCache.pm  |   12 +++++++
 Test.pm                       |    8 +++++
 Traits/CacheAlias.pm          |   18 ++++++++++
 13 files changed, 259 insertions(+), 0 deletions(-)
 create mode 100644 Entity/Artist.pm
 create mode 100644 Role/DataQuality.pm
 create mode 100644 Role/Editable.pm
 create mode 100644 Role/GID.pm
 create mode 100644 Role/ID.pm
 create mode 100644 Role/Name.pm
 create mode 100644 Role/SortName.pm
 create mode 100644 Storage/Artist.pm
 create mode 100644 Storage/Role/CacheAccessor.pm
 create mode 100644 Storage/Role/Memcached.pm
 create mode 100644 Storage/Role/ProcessCache.pm
 create mode 100644 Test.pm
 create mode 100644 Traits/CacheAlias.pm

diff --git a/Entity/Artist.pm b/Entity/Artist.pm
new file mode 100644
index 0000000..89cd7d8
--- /dev/null
+++ b/Entity/Artist.pm
@@ -0,0 +1,13 @@
+package Entity::Artist;
+use Moose;
+
+with 'Role::ID';
+with 'Role::GID';
+with 'Role::DataQuality';
+with 'Role::Editable';
+with 'Role::Name';
+with 'Role::SortName';
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+1;
diff --git a/Role/DataQuality.pm b/Role/DataQuality.pm
new file mode 100644
index 0000000..4cdbddf
--- /dev/null
+++ b/Role/DataQuality.pm
@@ -0,0 +1,9 @@
+package Role::DataQuality;
+use Moose::Role;
+
+has 'quality' => (
+    isa => 'Int',
+    is  => 'rw'
+);
+
+1;
diff --git a/Role/Editable.pm b/Role/Editable.pm
new file mode 100644
index 0000000..b179644
--- /dev/null
+++ b/Role/Editable.pm
@@ -0,0 +1,9 @@
+package Role::Editable;
+use Moose::Role;
+
+has 'edits' => (
+    isa => 'Int',
+    is  => 'rw'
+);
+
+1;
diff --git a/Role/GID.pm b/Role/GID.pm
new file mode 100644
index 0000000..9656082
--- /dev/null
+++ b/Role/GID.pm
@@ -0,0 +1,10 @@
+package Role::GID;
+use Moose::Role;
+
+has 'gid' => (
+    isa => 'Str',
+    is  => 'rw',
+    traits => [qw/Traits::CacheAlias/],
+);
+
+1;
diff --git a/Role/ID.pm b/Role/ID.pm
new file mode 100644
index 0000000..8c8b238
--- /dev/null
+++ b/Role/ID.pm
@@ -0,0 +1,9 @@
+package Role::ID;
+use Moose::Role;
+
+has 'id' => (
+    isa => 'Int',
+    is  => 'rw',
+);
+
+1;
diff --git a/Role/Name.pm b/Role/Name.pm
new file mode 100644
index 0000000..98b1fd2
--- /dev/null
+++ b/Role/Name.pm
@@ -0,0 +1,10 @@
+package Role::Name;
+use Moose::Role;
+
+has 'name' => (
+    isa => 'Str',
+    is  => 'rw',
+    traits => [qw/Traits::CacheAlias/],
+);
+
+1;
diff --git a/Role/SortName.pm b/Role/SortName.pm
new file mode 100644
index 0000000..def13c4
--- /dev/null
+++ b/Role/SortName.pm
@@ -0,0 +1,9 @@
+package Role::SortName;
+use Moose::Role;
+
+has 'sort_name' => (
+    isa => 'Str',
+    is  => 'rw',
+);
+
+1;
diff --git a/Storage/Artist.pm b/Storage/Artist.pm
new file mode 100644
index 0000000..4f35619
--- /dev/null
+++ b/Storage/Artist.pm
@@ -0,0 +1,69 @@
+package Storage::Artist;
+use Moose;
+
+with
+    'Storage::Role::Memcached' => {
+	alias => {
+	    from_cache => 'from_memcached',
+	    to_cache   => 'to_memcached'
+	} },
+    'Storage::Role::ProcessCache' => {
+	alias => {
+	    from_cache => 'from_process_cache',
+	    to_cache   => 'to_process_cache',
+	} },
+    'Storage::Role::CacheAccessor';
+
+use feature 'say';
+use Entity::Artist;
+
+sub load
+{
+    my ($self, %arguments) = @_;
+
+    my $artist = $self->get_cached(%arguments);
+    if (!defined $artist)
+    {
+	# Load from database
+	$artist = Entity::Artist->new(
+	    id => 5,
+	    name => 'Some Artist',
+	    sort_name => 'Artist, Some',
+	    quality => 1,
+	    gid => 'Hello',
+	);
+
+	# Store full copies
+	$self->store_cached($artist);
+    }
+
+    return $artist;
+}
+
+sub from_cache
+{
+    my $self = shift;
+
+    say "CACHE GET " . $_[0];
+
+    my $obj;
+    $obj ||= $self->from_memcached(@_);
+    $obj ||= $self->from_process_cache(@_);
+
+    return $obj;
+}
+
+sub to_cache
+{
+    my $self = shift;
+
+    say "CACHE SET " . $_[0];
+
+    $self->to_memcached(@_);
+    $self->to_process_cache(@_);
+}
+
+sub _model_class { 'Entity::Artist' }
+
+
+1;
diff --git a/Storage/Role/CacheAccessor.pm b/Storage/Role/CacheAccessor.pm
new file mode 100644
index 0000000..fb55d0a
--- /dev/null
+++ b/Storage/Role/CacheAccessor.pm
@@ -0,0 +1,70 @@
+package Storage::Role::CacheAccessor;
+use Moose::Role;
+
+requires 'to_cache', 'from_cache', '_model_class';
+
+sub get_cached
+{
+    my ($self, %arguments) = @_;
+
+    my $class = $self->_model_class;
+    my %all_attributes = %{ $class->meta->get_attribute_map };
+    my @attributes = map { $all_attributes{$_} } grep { exists $arguments{$_} } keys %all_attributes;
+
+    warn "Arguments contains no common columns in $class", return
+	unless scalar @attributes;
+
+    # See if we can load from the cache
+    my $cache_key;
+    if (exists $arguments{id})
+    {
+	# If we have ID we don't need to do any more work
+	$cache_key = $self->_form_key('id', $arguments{id});
+    }
+    elsif (my ($cache_alias_attr) = grep { $_->does('Traits::CacheAlias') } @attributes)
+    {
+	# Otherwise, we need to resolve a cache alias (if we can)
+	my $name = $cache_alias_attr->name;
+	my ($full_attr) = grep { $_->does('Traits::FullCache') } values %all_attributes;
+	my $val = $self->from_cache($self->_form_key($name, $arguments{$name}));
+
+	$cache_key = $self->_form_key($full_attr, $val)
+	    if ($val)
+    }
+
+    return $self->from_cache($cache_key)
+	if defined $cache_key;
+
+    return;
+}
+
+sub store_cached
+{
+    my ($self, $object) = @_;
+
+    my $key = $self->_form_key('id', $object->id);
+    $self->to_cache($key, $object);
+
+    # And store the aliases
+    my $class = $self->_model_class;
+    my %all_attributes = %{ $class->meta->get_attribute_map };
+    for my $attr (grep { $_->does('Traits::CacheAlias') } values %all_attributes)
+    {
+	my $meth = $attr->get_read_method;
+	my $key = $self->_form_key($attr->name, $object->$meth);
+	$self->to_cache($key, $object->id);
+    }
+}
+
+sub _form_key
+{
+    my ($self, $key, $value) = @_;
+
+    my $class = $self->_model_class;
+    my $ckey = "$class-$key-$value";
+    $ckey =~ s/\W/-/g;
+
+    return $ckey;
+}
+
+1;
diff --git a/Storage/Role/Memcached.pm b/Storage/Role/Memcached.pm
new file mode 100644
index 0000000..7bd0dd8
--- /dev/null
+++ b/Storage/Role/Memcached.pm
@@ -0,0 +1,13 @@
+package Storage::Role::Memcached;
+use Moose::Role;
+
+sub to_cache
+{
+}
+
+sub from_cache
+{
+}
+
+
+1;
diff --git a/Storage/Role/ProcessCache.pm b/Storage/Role/ProcessCache.pm
new file mode 100644
index 0000000..ff12f7d
--- /dev/null
+++ b/Storage/Role/ProcessCache.pm
@@ -0,0 +1,12 @@
+package Storage::Role::ProcessCache;
+use Moose::Role;
+
+sub to_cache
+{
+}
+
+sub from_cache
+{
+}
+
+1;
diff --git a/Test.pm b/Test.pm
new file mode 100644
index 0000000..23be917
--- /dev/null
+++ b/Test.pm
@@ -0,0 +1,8 @@
+use feature 'say';
+
+use Storage::Artist;
+
+my $artist_model = Storage::Artist->new;
+
+say "Loading artist with GUID = hello";
+my $artist = $artist_model->load(gid => 'hello');
diff --git a/Traits/CacheAlias.pm b/Traits/CacheAlias.pm
new file mode 100644
index 0000000..841821c
--- /dev/null
+++ b/Traits/CacheAlias.pm
@@ -0,0 +1,18 @@
+package Traits::CacheAlias;
+use Moose::Role;
+
+=head1 NAME
+
+Traits::CacheAlias
+
+=head1 DESCRIPTION
+
+Indicate that if this object is to be loaded from cache, the cache for this attribute
+will contain the value of a full cache key.
+
+=cut
+
+package Moose::Meta::Attribute::Custom::Traits::CacheAlias;
+sub register_implementation { 'Traits::CacheAlias' }
+
+1;
-- 
1.6.2.3