Author: dylan
Date: 2005-01-09 21:53:48 -0500 (Sun, 09 Jan 2005)
New Revision: 581
Removed:
trunk/main/server/lib/Haver/Server/Entity/POE.pm
Modified:
trunk/main/server/lib/Haver/Server/Entity.pm
trunk/main/server/lib/Haver/Server/Entity/Avatar.pm
trunk/main/server/lib/Haver/Server/Entity/Room.pm
trunk/main/server/lib/Haver/Server/Speaker.pm
Log:
first commit o' the night.
Modified: trunk/main/server/lib/Haver/Server/Entity/Avatar.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Entity/Avatar.pm 2005-01-09 05:50:24 UTC
(rev 580)
+++ trunk/main/server/lib/Haver/Server/Entity/Avatar.pm 2005-01-10 02:53:48 UTC
(rev 581)
@@ -1,6 +1,6 @@
# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
# This module is copyrighted, see end of file for details.
-package Haver::Server::Object::User;
+package Haver::Server::Entity::Avatar;
use strict;
use warnings;
use Carp;
@@ -15,42 +15,43 @@
sub initialize {
my ($me) = @_;
- # ASSERT: exists $me->{wheel};
+ $me->SUPER::initialize();
- $me->{_access} = {};
- $me->{_channels} = {};
+ croak "required paramter: -wheel" unless $me->{'-wheel'};
+
+ $me->{access} = {};
}
-sub wheel { $_[0]{wheel} }
+sub wheel {
+ $_[0]{'-wheel'}
+}
+sub grant {
+ my ($me, $where, $what, $level) = @_;
+ # ASSERT: defined $where;
+ # ASSERT: defined $what;
+ $level ||= 1;
-sub add_channel {
- my ($me, $cid) = @_;
- # ASSERT: defined $cid;
- croak "add_channel(): channel previously added!" if exists
$me->{_channels}{$cid};
- $me->{_channels}{$cid} = 1;
+ $me->{access}{$where}{$what} = $level;
}
-sub remove_channel {
- my ($me, $cid) = @_;
- # ASSERT: defined $cid;
- croak "remove_channel(): channel not added!" if not exists
$me->{_channels}{$cid};
-
- delete $me->{_channels}{$cid};
-}
+sub revoke {
+ my ($me, $where, $what) = @_;
+ # ASSERT: defined $where;
+ # ASSERT: defined $what;
-sub has_channel {
- my ($me, $cid) = @_;
- # ASSERT: defined $cid;
-
- exists $me->{_channels}{$cid};
+ return undef if not exists $me->{access}{$where};
+ return delete $me->{access}{$where}{$what};
}
-sub channels {
- my ($me) = @_;
- my @chans = keys %{ $me->{_channels} };
+sub may {
+ my ($me, $where, $what) = @_;
+ # ASSERT: defined $where;
+ # ASSERT: defined $what;
- wantarray ? @chans : [EMAIL PROTECTED] ;
+ return undef unless exists $me->{access}{$where};
+ return undef unless exists $me->{access}{$where}{$what};
+ return $me->{access}{$where}{$what};
}
# Now for the API manual.
@@ -58,11 +59,11 @@
=head1 NAME
-Haver::Server::Object::User - An object that contains information about a user.
+Haver::Server::Entity::Avatar - An object that contains information about a
user.
=head1 SYNOPSIS
- use Haver::Server::Object::User;
+ use Haver::Server::Entity::Avatar;
# FIXME
=head1 DESCRIPTION
@@ -71,36 +72,43 @@
=head1 INHERITENCE
-Haver::Server::Object::Object extends L<Haver::Server::Object>.
+Haver::Server::Entity::Avatar extends L<Haver::Server::Entity>.
+=head1 CONSTRUCTOR
+
+The constructor requires a C<-wheel> parameter, which is the read/write
+wheel of the associated session.
+
+It also requires C<-id> parameter, because of inheritence.
+
=head1 METHODS
-Haver::Server::Object::Object implements the following methods:
+This class implements the following methods:
-=head2 namespace(Z<>)
+=head2 wheel(Z<>)
-Returns 'user';
+Returns the I/O wheel of the avatar's Speaker session.
-=head2 add_channel($cid)
+=head2 grant($room, $perm, $level=1)
-Add the channel id $cid to the list of channels the user is joined to.
+Grants permision $perm in room $room with authority $level (default: 1).
-=head2 remove_channel($cid)
+=head2 revoke($room, $perm)
-Remove the channel id $cid from the list of joined channels.
+Removes permision $perm in room $room.
-=head2 has_channel($cid)
+=head2 may($room, $perm)
-Returns true if the user is joined to the channel $cid. False otherwise.
+Returns the access level for $perm in room $room.
+Returns undef when $perm has never been granted for $room.
-=head2 channels()
+=head1 FIELDS
-In scalar context, returns an arrayref of the channels this user is joined to.
-In list context, returns a list.
+The field C<access> is reserved by this class.
=head1 BUGS
-None known. Bug reports are welcome. Please use our bug tracker at
+None known. Bug reports are willelcome. Please use our bug tracker at
L<http://gna.org/bugs/?func=additem&group=haver>.
=head1 AUTHOR
@@ -109,7 +117,7 @@
=head1 SEE ALSO
-L<Haver::Server::Object::User>, L<Haver::Server::Object::Channel>.
+L<Haver::Server::Entity::User>, L<Haver::Server::Entity::Room>.
=head1 COPYRIGHT and LICENSE
Deleted: trunk/main/server/lib/Haver/Server/Entity/POE.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Entity/POE.pm 2005-01-09 05:50:24 UTC
(rev 580)
+++ trunk/main/server/lib/Haver/Server/Entity/POE.pm 2005-01-10 02:53:48 UTC
(rev 581)
@@ -1,53 +0,0 @@
-# vim: set ft=perl ts=4 sw=4:
-# Haver::Server::Object::POE - Add poe methods to Haver::Server::Objects
-#
-# Copyright (C) 2004 Dylan William Hardison.
-#
-# 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
-package Haver::Server::Object;
-use strict;
-use warnings;
-
-use POE;
-
-our $VERSION = 0.01;
-
-sub wheel : lvalue {
- my ($me) = @_;
-
- $me->{wheel};
-}
-
-sub sid : lvalue {
- my ($me) = @_;
-
- $me->{sid};
-}
-
-sub put {
- my ($me, $msg) = @_;
-
- $me->{wheel}->put($msg);
-}
-
-sub post {
- my $me = shift;
-
- $poe_kernel->post($me->{sid}, @_);
-}
-
-
-1;
-
Modified: trunk/main/server/lib/Haver/Server/Entity/Room.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Entity/Room.pm 2005-01-09 05:50:24 UTC
(rev 580)
+++ trunk/main/server/lib/Haver/Server/Entity/Room.pm 2005-01-10 02:53:48 UTC
(rev 581)
@@ -12,11 +12,11 @@
my ($me) = @_;
$me->SUPER::initialize;
- $me->{_contents} = {};
+ $me->{contents} = {};
}
sub namespace {
- return 'channel';
+ return 'room';
}
sub add {
@@ -27,7 +27,7 @@
croak ref($me) . " can't contain $object!" unless
$me->can_contain($object);
- $me->{_contents}{$ns}{$id} = $object;
+ $me->{contents}{$ns}{lc $id} = $object;
}
sub can_contain {
@@ -38,26 +38,28 @@
sub fetch {
my ($me, $ns, $id) = @_;
+ $id = lc $id;
- return undef unless exists $me->{_contents}{$ns};
- return undef unless exists $me->{_contents}{$ns}{$id};
- return $me->{_contents}{$ns}{$id};
+ return undef unless exists $me->{contents}{$ns};
+ return undef unless exists $me->{contents}{$ns}{$id};
+ return $me->{contents}{$ns}{$id};
}
sub remove {
my ($me, $ns, $id) = @_;
+ $id = lc $id;
- return undef unless exists $me->{_contents}{$ns};
- return undef unless exists $me->{_contents}{$ns}{$id};
- return delete $me->{_contents}{$ns}{$id};
+ return undef unless exists $me->{contents}{$ns};
+ return undef unless exists $me->{contents}{$ns}{$id};
+ return delete $me->{contents}{$ns}{$id};
}
sub contents {
my ($me, $ns) = @_;
my @values = ();
- if (exists $me->{_contents}{$ns}) {
- @values = values %{ $me->{_contents}{$ns} };
+ if (exists $me->{contents}{$ns}) {
+ @values = values %{ $me->{contents}{$ns} };
}
return wantarray ? @values : [EMAIL PROTECTED];
@@ -66,8 +68,8 @@
sub contains {
my ($me, $ns, $id) = @_;
- return undef unless exists $me->{_contents}{$ns};
- return exists $me->{_contents}{$ns}{$id};
+ return undef unless exists $me->{contents}{$ns};
+ return exists $me->{contents}{$ns}{lc $id};
}
@@ -93,7 +95,7 @@
=head1 INHERITENCE
-Haver::Server::Entity::Room extends L<Haver::Server::Object>.
+Haver::Server::Entity::Room extends L<Haver::Server::Entity>.
=head1 METHODS
@@ -101,7 +103,7 @@
=head2 namespace(Z<>)
-Returns 'channel'.
+Returns 'room'
=head2 add($thing)
@@ -137,6 +139,11 @@
In scalar context, returns an arrayref. In list context, it returns a list.
+
+=head1 FIELDS
+
+This class reserves the field C<contents>.
+
=head1 BUGS
None known. Bug reports are welcome. Please use our bug tracker at
Modified: trunk/main/server/lib/Haver/Server/Entity.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Entity.pm 2005-01-09 05:50:24 UTC
(rev 580)
+++ trunk/main/server/lib/Haver/Server/Entity.pm 2005-01-10 02:53:48 UTC
(rev 581)
@@ -19,14 +19,14 @@
sub initialize {
my ($me) = @_;
- croak "required paramter: id" unless $me->{id};
- $me->{_attribs} = { };
+ croak "required paramter: -id" unless $me->{'-id'};
+ $me->{attribs} = { };
}
sub id {
my ($me) = @_;
- return $me->{id};
+ return $me->{'-id'};
}
sub set {
@@ -34,7 +34,7 @@
croak "Too few args!" if @_ < 3;
croak "Too many args, use set_many!" if @_ > 3;
- $me->{_attribs}{$key} = $val;
+ $me->{attribs}{$key} = $val;
}
@@ -44,8 +44,8 @@
croak "Too few args!" if @_ < 1;
croak "Too many args, try get_many!" if @_ > 1;
- if (exists $me->{_attribs}{$key}) {
- return $me->{_attribs}{$key};
+ if (exists $me->{attribs}{$key}) {
+ return $me->{attribs}{$key};
} else {
return undef;
}
@@ -55,7 +55,7 @@
sub get_many {
my $me = shift;
my @ret = ();
- my $f = $me->{_attribs};
+ my $f = $me->{attribs};
foreach my $key (@_) {
push @ret, exists $f->{$key} ? $f->{$key} : undef;
@@ -69,7 +69,7 @@
croak "Too few args" if @_ < 2;
croak "Too many args" if @_ > 2;
- delete $me->{_attribs}{$key};
+ delete $me->{attribs}{$key};
}
sub has {
@@ -77,7 +77,7 @@
croak "Too few args!" if @_ < 2;
croak "Too many args!" if @_ > 2;
- return exists $me->{_attribs}{$key};
+ return exists $me->{attribs}{$key};
}
@@ -100,25 +100,19 @@
Haver::Server::Entity extends L<Haver::Base>.
+=head1 CONSTRUCTOR
+
+The parameter C<-id> is required.
+
=head1 METHODS
Haver::Server::Entity supports the following methods:
-=head2 new(%params | \%params)
-This is the constructor, inherited from L<Haver::Base>.
-The parameter "id" is required.
-
=head2 id(Z<>)
Returns the id (name) of the object.
-=head2 namespace(Z<>)
-
-Returns the namespace of the object.
-
-This method B<must> be implemented by subclasses.
-
=head2 set($key, $val)
Set the attribute C<$key> to C<$val> on the current object.
@@ -140,6 +134,21 @@
Returns true if the attribute C<$key> is set, false otherwise.
+=head1 VIRTUAL METHODS
+
+The follow methods may be implemented by subclasses:
+
+=head2 namespace(Z<>)
+
+Returns the namespace of the object.
+
+This method B<must> be implemented by subclasses.
+
+
+=head1 FIELDS
+
+The field C<attribs> is reserved.
+
=head1 AUTHOR
Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
Modified: trunk/main/server/lib/Haver/Server/Speaker.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Speaker.pm 2005-01-09 05:50:24 UTC
(rev 580)
+++ trunk/main/server/lib/Haver/Server/Speaker.pm 2005-01-10 02:53:48 UTC
(rev 581)
@@ -1,4 +1,4 @@
-# Haver::Server::Avatar,
+# Haver::Server::Speaker,
# this creates a session, which represents the user...
#
# Copyright (C) 2003 Dylan William Hardison.
@@ -18,7 +18,7 @@
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# TODO, write POD. Soon.
-package Haver::Server::Avatar;
+package Haver::Server::Speaker;
use strict;
use Carp qw(croak confess carp cluck);
@@ -29,7 +29,7 @@
Filter::Haver
);
-use Haver::Server::Commands;
+use Haver::Server::Events;
use Haver::Server::Registry qw( $Registry );
our $RELOAD = 1;
