Author: spadkins
Date: Fri Feb 22 12:49:49 2008
New Revision: 10820
Added:
p5ee/trunk/App-Context/lib/App/SharedDatastore/
p5ee/trunk/App-Context/t/SharedDatastore.t (contents, props changed)
Modified:
p5ee/trunk/App-Context/CHANGES
p5ee/trunk/App-Context/lib/App/SharedDatastore.pm
Log:
add new service, SharedDatastore
Modified: p5ee/trunk/App-Context/CHANGES
==============================================================================
--- p5ee/trunk/App-Context/CHANGES (original)
+++ p5ee/trunk/App-Context/CHANGES Fri Feb 22 12:49:49 2008
@[EMAIL PROTECTED]
-2,6 +2,15 @[EMAIL PROTECTED]
# CHANGE LOG
#########################################
+VERSION 0.966 (unreleased)
+ o add SharedDatastore as a useful service (with a Repository-based
implementation)
+ o improved support for "temporary" services (named "temporary" or with
the {temporary} arg)
+ (a "temporary service" is akin to a stateless session bean in Java)
+ o add support for including/overlaying additional config files based on
values present in
+ the %$options hash or when a particular named service is instantiated
+ o App::Context::POE::Server
+ o App::Context::POE::ClusterController, App::Context::POE::ClusterNode
+
VERSION 0.965
x add UI timing log, activated by "app.Context.timer" option
Modified: p5ee/trunk/App-Context/lib/App/SharedDatastore.pm
==============================================================================
--- p5ee/trunk/App-Context/lib/App/SharedDatastore.pm (original)
+++ p5ee/trunk/App-Context/lib/App/SharedDatastore.pm Fri Feb 22 12:49:49
2008
@[EMAIL PROTECTED]
-12,6 +12,11 @[EMAIL PROTECTED]
use strict;
+use Storable qw(nfreeze thaw);
+use Digest::SHA qw(sha1_hex);
+
+$Storable::canonical = 1; # this will cause hashes to be serialized the
same way every time
+
=head1 NAME
App::SharedDatastore - Interface for sharing data between processes
@[EMAIL PROTECTED]
-75,9 +80,6 @[EMAIL PROTECTED]
implementations than an MLDBM (MLDBM is one of the implementations).
It also does not support the "tie" interface.
- * Throws: App::Exception::SharedDatastore
- * Since: 0.01
-
=cut
#############################################################################
@[EMAIL PROTECTED]
-100,6 +102,27 @[EMAIL PROTECTED]
=cut
#############################################################################
+# _init()
+#############################################################################
+
+=head2 _init()
+
+=cut
+
+sub _init {
+ &App::sub_entry if ($App::trace);
+ my ($self) = @[EMAIL PROTECTED]
$self->{data} = {};
+ if ($self->{compress}) {
+ require Compress::Zlib;
+ }
+ if ($self->{base64}) {
+ App->use("MIME::Base64");
+ }
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
# PUBLIC METHODS
#############################################################################
@[EMAIL PROTECTED]
-108,103 +131,236 @[EMAIL PROTECTED]
=cut
#############################################################################
+# set()
+#############################################################################
+
+=head2 set()
+
+ * Signature: $sds->set($key, $value);
+ * Signature: $sds->set($key, $value, $options);
+ * Param: $key scalar
+ * Param: $value scalar
+ * Param: $options HASH (optional)
+ * Return: void
+
+ $sds->set($key,$value);
+ $options = {
+ info_columns => [ "col1", "col2" ],
+ info_values => [ "value1", "value2" ],
+ };
+ $sds->set($key, $value, $options);
+
+=cut
+
+sub set {
+ &App::sub_entry if ($App::trace);
+ my ($self, $key, $value, $options) = @[EMAIL PROTECTED]
$self->{data}{$key} = $value;
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
# get()
#############################################################################
=head2 get()
* Signature: $value = $sds->get($key);
- * Param: $key string
- * Return: $value anything
- * Throws: App::Exception::SharedDatastore
- * Since: 0.01
+ * Param: $key scalar
+ * Return: $value scalar
- Sample Usage:
-
- $context = App->context();
- $sds = $context->service("SharedDatastore");
- $hash = $sds->get("user.spadkins");
- print %$hash, "\n";
+ $value = $sds->get($key);
=cut
sub get {
+ &App::sub_entry if ($App::trace);
my ($self, $key) = @[EMAIL PROTECTED]
return($self->{$key}); #dummy implementation
+ my $value = $self->{data}{$key};
+ &App::sub_exit($value) if ($App::trace);
+ return($value);
}
#############################################################################
-# set()
+# set_ref()
#############################################################################
-=head2 set()
+=head2 set_ref()
- * Signature: $value = $sds->set($key,$value);
- * Param: $key string
- * Param: $value anything
+ * Signature: $sds->set_ref($keyref,$valueref);
+ * Signature: $sds->set_ref($keyref,$valueref,$options);
+ * Param: $keyref anything (ref or scalar)
+ * Param: $valueref anything (ref or scalar)
+ * Param: $options HASH (optional)
* Return: void
- * Throws: App::Exception::SharedDatastore
- * Since: 0.01
- Sample Usage:
+ $sds->set_ref($keyref, $valueref);
+ $options = {
+ info_columns => [ "col1", "col2" ],
+ info_values => [ "value1", "value2" ],
+ };
+ $sds->set_ref($keyref, $valueref, $options);
- $context = App->context();
- $sds = $context->service("SharedDatastore");
- $hash = $sds->set("user.spadkins");
- print %$hash, "\n";
+=cut
+
+sub set_ref {
+ &App::sub_entry if ($App::trace);
+ my ($self, $keyref, $valueref, $options) = @[EMAIL PROTECTED]
my $hashkey = $self->hashkey($keyref);
+ my $blob = $self->serialize($valueref);
+ $self->set($hashkey, $blob, $options);
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
+# get_ref()
+#############################################################################
+
+=head2 get_ref()
+
+ * Signature: $valueref = $sds->get_ref($keyref);
+ * Param: $keyref anything (ref or scalar)
+ * Return: $valueref anything (ref or scalar)
+
+ $valueref = $sds->get_ref($keyref);
=cut
-sub set {
- my ($self, $key, $value) = @[EMAIL PROTECTED]
$self->{$key} = $value; #dummy implementation
+sub get_ref {
+ &App::sub_entry if ($App::trace);
+ my ($self, $keyref) = @[EMAIL PROTECTED]
my $hashkey = $self->hashkey($keyref);
+ my $blob = $self->get($hashkey);
+ my $valueref = (defined $blob) ? $self->deserialize($blob) : undef;
+ &App::sub_exit($valueref) if ($App::trace);
+ return($valueref);
}
#############################################################################
-# PROTECTED METHODS
+# serialize()
#############################################################################
-=head1 Protected Methods:
+=head2 serialize()
+
+ * Signature: $blob = $sds->serialize($ref);
+ * Return: $ref any (ref)
+ * Return: $blob scalar (binary)
+
+ $blob = $sds->serialize($ref);
=cut
+sub serialize {
+ &App::sub_entry if ($App::trace);
+ my ($self, $ref) = @[EMAIL PROTECTED]
my ($blob);
+ if (defined $ref) {
+ $blob = nfreeze($ref);
+ if ($self->{compress}) {
+ $blob = Compress::Zlib::memGzip($blob);
+ }
+ if ($self->{base64}) {
+ $blob = MIME::Base64::encode($blob);
+ }
+ }
+ else {
+ $blob = undef;
+ }
+ &App::sub_exit("<frozen-ref>") if ($App::trace);
+ return($blob);
+}
+
#############################################################################
-# Method: service_type()
+# deserialize()
#############################################################################
-=head2 service_type()
+=head2 deserialize()
-Returns 'SharedDatastore';
+ * Signature: $ref = $sds->deserialize($blob);
+ * Param: $blob scalar (binary)
+ * Return: $ref any (ref)
+
+
+ $ref = $sds->deserialize($blob);
- * Signature: $service_type = App::SharedDatastore->service_type();
- * Param: void
- * Return: $service_type string
- * Since: 0.01
+=cut
+
+sub deserialize {
+ &App::sub_entry if ($App::trace);
+ my ($self, $blob) = @[EMAIL PROTECTED]
my ($ref);
+ if (defined $blob) {
+ if ($self->{base64}) {
+ $blob = MIME::Base64::decode($blob);
+ }
+ if ($self->{compress}) {
+ $blob = Compress::Zlib::memGunzip($blob);
+ }
+ $ref = thaw($blob);
+ }
+ else {
+ $ref = undef;
+ }
+ &App::sub_exit($ref) if ($App::trace);
+ return($ref);
+}
- $service_type = $sdata->service_type();
+#############################################################################
+# hashkey()
+#############################################################################
+
+=head2 hashkey()
+
+ * Signature: $hashkey = $sds->hashkey($keyref);
+ * Return: $keyref any (ref or scalar)
+ * Return: $hashkey scalar
+
+ $hashkey = $sds->deserialize($keyref);
=cut
-sub service_type () { 'SharedDatastore'; }
+sub hashkey {
+ &App::sub_entry if ($App::trace);
+ my ($self, $keyref) = @[EMAIL PROTECTED]
my ($hashkey);
+ if (ref($keyref)) {
+ $hashkey = sha1_hex(nfreeze($keyref));
+ }
+ elsif (length($keyref) == 40 && $keyref =~ /^[a-f0-9]+$/) {
+ $hashkey = $keyref;
+ }
+ else {
+ $hashkey = sha1_hex($keyref);
+ }
+ &App::sub_exit($hashkey) if ($App::trace);
+ return($hashkey);
+}
#############################################################################
-# Method: _serialize()
+# PROTECTED METHODS
#############################################################################
-=head2 _serialize()
+=head1 Protected Methods:
- * Signature: $blob = $self->_serialize($ref);
- * Param: $ref any
- * Return: $blob scalar
- * Since: 0.01
+=cut
- $blob = $self->_serialize($ref);
+#############################################################################
+# Method: service_type()
+#############################################################################
+
+=head2 service_type()
+
+Returns "SharedDatastore";
+
+ * Signature: $service_type = App::SharedDatastore->service_type();
+ * Param: void
+ * Return: $service_type string
+
+ $service_type = $sds->service_type();
=cut
-sub _serialize {
- my ($self, $ref) = @[EMAIL PROTECTED]
service_type () { "SharedDatastore"; }
=head1 ACKNOWLEDGEMENTS
Added: p5ee/trunk/App-Context/t/SharedDatastore.t
==============================================================================
--- (empty file)
+++ p5ee/trunk/App-Context/t/SharedDatastore.t Fri Feb 22 12:49:49 2008
@[EMAIL PROTECTED]
-0,0 +1,95 @[EMAIL PROTECTED]
-w
+
+use strict;
+
+use Test::More qw(no_plan);
+use lib "lib";
+use lib "../lib";
+
+BEGIN {
+ use_ok("App");
+}
+
+my $context = App->context(
+ conf_file => "",
+ conf => {
+ SharedDatastore => {
+ simple => {
+ class => "App::SharedDatastore",
+ },
+ compress => {
+ class => "App::SharedDatastore",
+ compress => 1,
+ },
+ base64 => {
+ class => "App::SharedDatastore",
+ base64 => 1,
+ },
+ compress_base64 => {
+ class => "App::SharedDatastore",
+ compress => 1,
+ base64 => 1,
+ },
+ },
+ },
+);
+
+{
+ my ($sds, $key, $value, $keyref, $valueref, $valueref2, $hashkey,
$serialized_value);
+
+ foreach my $name ("default", "simple", "compress", "base64",
"compress_base64") {
+ $sds = $context->service("SharedDatastore", $name);
+ ok(defined $sds, "[$name] constructor ok");
+
+ isa_ok($sds, "App::SharedDatastore", "[$name] right class");
+ is($sds->service_type(), "SharedDatastore", "[$name] right
service type");
+
+ my $dump = $sds->dump();
+ ok($dump =~ /^\$SharedDatastore__$name = /, "[$name] dump");
+
+ $sds->set("pi", 3.1416);
+ $value = $sds->get("pi");
+ is($value, 3.1416, "[$name] set()/get() works (for pi=$value)");
+
+ $keyref = [ "person",
+ { "age.ge" => 21, last_name => "Adkins" },
+ [ "person_id", "last_name", "first_name", "age", "eye_color"
],
+ { numrows => 20, cache => {}, },
+ ];
+ $valueref = [
+ [ 1, "Adkins", "Stephen", 40, "Blue", ],
+ [ 2, "Adkins", "Susan (Little)", 40, "Brown", ],
+ [ 3, "Adkins", "Bill", 43, "Brown", ],
+ [ 4, "Adkins", "Susan", 44, "Brown", ],
+ [ 5, "Adkins", "Marybeth", 47, "Blue", ],
+ ];
+
+ $sds->set_ref($keyref, $valueref);
+ $valueref2 = $sds->get_ref($keyref);
+ is_deeply($valueref, $valueref2, "[$name] set_ref()/get_ref()
works");
+
+ $hashkey = $sds->hashkey($keyref);
+ $valueref2 = $sds->get_ref($hashkey);
+ is_deeply($valueref, $valueref2, "[$name]
set_ref()/get_ref(hashkey) works (hashkey=$hashkey)");
+
+ $serialized_value = $sds->serialize($valueref);
+ $value = $sds->get($hashkey);
+ is($value, $serialized_value, "[$name] set_ref()/get(hashkey)
works");
+
+ $valueref2 = $sds->deserialize($serialized_value);
+ is_deeply($valueref, $valueref2, "[$name]
serialize()/deserialize() works");
+
+ $value = $sds->get("foo");
+ is($value, undef, "[$name] get(foo) is undef");
+
+ $valueref2 = $sds->get_ref("foo");
+ is($valueref2, undef, "[$name] get_ref(foo) is undef");
+
+ $sds->set_ref("foo", undef);
+ $value = $sds->get_ref("foo");
+ is($value, undef, "[$name] get_ref(foo) is undef after set to
undef");
+ }
+}
+
+exit 0;
+
|
