Author: dylan
Date: 2005-06-23 21:55:21 -0400 (Thu, 23 Jun 2005)
New Revision: 806
Added:
trunk/perl/server/lib/Haver/Server/Store.pm
trunk/perl/server/t/004_store.t
Modified:
trunk/
trunk/perl/server/lib/Haver/Server/Entity.pm
trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
trunk/perl/server/t/001_avatar.t
trunk/perl/server/t/003_entity.t
Log:
[EMAIL PROTECTED]: dylan | 2005-06-23 16:51:35 -0400
Okay, getting closer to persistent users and channels and what-not.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1153
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1160
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2005-06-23 10:34:47 UTC
(rev 805)
+++ trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2005-06-24 01:55:21 UTC
(rev 806)
@@ -23,7 +23,7 @@
}
}
-sub save {
+sub dump {
my ($self) = @_;
my $data = super;
$data->{access} = $self->_access;
@@ -31,9 +31,11 @@
}
sub load {
- my ($self, $data) = @_;
- super($data);
+ my ($this, $data) = @_;
+ my $self = super($data);
$self->_access($data->{access});
+
+ return $self;
}
sub grant {
Modified: trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2005-06-23
10:34:47 UTC (rev 805)
+++ trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2005-06-24
01:55:21 UTC (rev 806)
@@ -34,7 +34,7 @@
$self->{_contents}{$ns}{$name} = $object;
}
-sub fetch {
+sub get {
my ($self, $ns, $name) = @_;
$name = lc $name;
@@ -43,6 +43,12 @@
return $self->{_contents}{$ns}{$name};
}
+sub fetch {
+ my $self = shift;
+ carp "fetch() is deprecated";
+ $self->get(@_);
+}
+
sub remove {
my ($self, $ns, $name) = @_;
$name = lc $name;
Modified: trunk/perl/server/lib/Haver/Server/Entity.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity.pm 2005-06-23 10:34:47 UTC
(rev 805)
+++ trunk/perl/server/lib/Haver/Server/Entity.pm 2005-06-24 01:55:21 UTC
(rev 806)
@@ -6,19 +6,25 @@
use Haver::Base -base;
use Haver::Util;
-field _name => '&undef';
field attr => {};
stub 'namespace';
stub 'put';
+sub initialize {
+ my ($self) = @_;
+ if (not exists $self->{name}) {
+ $self->{name} = '&undef';
+ }
+}
+
sub name {
my $self = shift;
if (@_ == 0) {
- return $self->{_name};
+ return $self->{name};
} else {
my $name = shift;
if (Haver::Util::is_valid_name($name)) {
- return $self->{_name} = $name;
+ return $self->{name} = $name;
} else {
croak "Can't set name to invalid value of $name!";
}
@@ -27,13 +33,14 @@
sub load {
- my ($self, $data) = @_;
+ my ($this, $data) = @_;
+ my $self = $this->new;
$self->name($data->{name});
$self->attr($data->{attr});
return $self;
}
-sub save {
+sub dump {
my ($self) = @_;
return {
name => $self->name,
Added: trunk/perl/server/lib/Haver/Server/Store.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Store.pm 2005-06-23 10:34:47 UTC (rev
805)
+++ trunk/perl/server/lib/Haver/Server/Store.pm 2005-06-24 01:55:21 UTC (rev
806)
@@ -0,0 +1,122 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Store;
+use strict;
+use warnings;
+use Haver::Base -base;
+use File::Spec;
+use YAML ();
+
+our $VERSION = 0.01;
+
+field storedir => File::Spec->curdir;
+
+sub insert {
+ my ($self, $entity) = @_;
+ my $data = $entity->dump;
+ my $file = $self->filename($entity->namespace, $entity->name);
+ my $dir = $self->dirname($entity->namespace);
+
+ if (not -e $dir) {
+ mkdir($dir) or croak "Can't mkdir($dir): $!";
+ }
+
+ $self->save_file($file, ref($entity), $data);
+}
+
+sub fetch {
+ my ($self, $ns, $name) = @_;
+ my $file = $self->filename($ns, $name);
+ my ($class, $data) = @{ $self->load_file($file) };
+ return $class->load($data);
+}
+
+sub delete {
+ my ($self, $ns, $name) = @_;
+ my $file = $self->filename($ns, $name);
+ unlink($file) or croak "Can't delete $ns/$name!";
+}
+
+sub save_file {
+ my ($self, $file, $class, $data) = @_;
+
+ YAML::DumpFile($file, [
+ $class,
+ $data,
+ ]
+ );
+}
+
+sub load_file {
+ my ($self, $file) = @_;
+ YAML::LoadFile($file);
+}
+
+sub filename {
+ my ($self, $ns, $name) = @_;
+ File::Spec->catfile($self->storedir, $ns, $name)
+}
+
+sub dirname {
+ my ($self, $ns) = @_;
+ File::Spec->catfile($self->storedir, $ns)
+}
+
+1;
+__END__
+=head1 NAME
+
+Haver::Server::Store - description
+
+=head1 SYNOPSIS
+
+ use Haver::Server::Store;
+ # Small code example.
+
+=head1 DESCRIPTION
+
+FIXME
+
+=head1 INHERITENCE
+
+Haver::Server::Store extends L<Haver::Base>
+
+=head1 METHODS
+
+This class implements the following methods:
+
+=head2 method1(Z<>)
+
+...
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This module is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Modified: trunk/perl/server/t/001_avatar.t
===================================================================
--- trunk/perl/server/t/001_avatar.t 2005-06-23 10:34:47 UTC (rev 805)
+++ trunk/perl/server/t/001_avatar.t 2005-06-24 01:55:21 UTC (rev 806)
@@ -23,9 +23,8 @@
is_deeply(['FOO', 'bar', 'baz'], $dummy->msg, 'put()');
$ava->grant('&lobby', 'kick', 10);
-my $data = $ava->save;
-my $ava2 = new Haver::Server::Entity::Avatar;
-$ava2->load($data);
+my $data = $ava->dump;
+my $ava2 = Haver::Server::Entity::Avatar->load($data);
is($ava->may('&lobby', 'kick'), $ava2->may('&lobby', 'kick'), "saving/loading
ACLs");
BEGIN {
Modified: trunk/perl/server/t/003_entity.t
===================================================================
--- trunk/perl/server/t/003_entity.t 2005-06-23 10:34:47 UTC (rev 805)
+++ trunk/perl/server/t/003_entity.t 2005-06-24 01:55:21 UTC (rev 806)
@@ -27,8 +27,7 @@
}
is($ent->name, 'thing', "Is the name the same?");
-my $data = $ent->save;
-my $ent2 = new Haver::Server::Entity;
-$ent2->load($data);
+my $data = $ent->dump;
+my $ent2 = Haver::Server::Entity->load($data);
is_deeply($ent, $ent2, "saving and loading works");
Added: trunk/perl/server/t/004_store.t
===================================================================
--- trunk/perl/server/t/004_store.t 2005-06-23 10:34:47 UTC (rev 805)
+++ trunk/perl/server/t/004_store.t 2005-06-24 01:55:21 UTC (rev 806)
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+
+use Test::More tests => 8;
+use Haver::Server::Entity::User;
+use Haver::Server::Entity::Channel;
+BEGIN { use_ok('Haver::Server::Store') };
+
+my $user = new Haver::Server::Entity::User (
+ name => 'bobby',
+ attr => {
+ away => "sleeping",
+ },
+);
+my $chan = new Haver::Server::Entity::Channel (
+ name => 'lobby',
+ attr => {
+ topic => "Bunnies",
+ },
+);
+my $store = new Haver::Server::Store (
+ storedir => 't/',
+);
+
+
+ok($store, "create store object");
+$store->insert($user);
+ok(-e 't/user/bobby', "save user to store");
+my $user2 = $store->fetch('user', 'bobby');
+is_deeply($user, $user2, "load user");
+
+$store->insert($chan);
+ok(-e 't/channel/lobby', "save channel to store");
+my $chan2 = $store->fetch('channel', 'lobby');
+is_deeply($chan, $chan2, "load channel");
+
+$store->delete('user', 'bobby');
+$store->delete('channel', 'lobby');
+
+ok(not(-e 't/user/bobby'), "delete user from store");
+ok(not(-e 't/channel/lobby'), "delete channel from store");
