Author: dylan
Date: 2005-01-01 04:01:10 -0500 (Sat, 01 Jan 2005)
New Revision: 504
Modified:
trunk/docs/guidelines.txt
trunk/main/server/lib/Haver/Server/Object.pm
trunk/main/server/lib/Haver/Server/Object/Channel.pm
Log:
a few small updates on the guidelines and some new code and docs. :)
Modified: trunk/docs/guidelines.txt
===================================================================
--- trunk/docs/guidelines.txt 2005-01-01 07:43:59 UTC (rev 503)
+++ trunk/docs/guidelines.txt 2005-01-01 09:01:10 UTC (rev 504)
@@ -66,19 +66,14 @@
At least, when a module is in a "usable" state,
it should have documentation.
* Documents should contain NAME, SYNOPSIS, DESCRIPTION, SEE ALSO, AUTHOR,
- and COPYRIGHT AND LICENSE sections.
- * Additional, optional, sections include EXPORTS (after DESCRIPTION),
INHERITANCE (after NAME),
+ and COPYRIGHT and LICENSE sections.
+ * Additional, optional, sections include EXPORTS (after DESCRIPTION),
INHERITANCE (before METHODS),
FUNCTIONS and/or METHODS after DESCRIPTION, and perhaps ABSTRACT before
DESCRIPTION,
if DESCRIPTION is somewhat long or complicated.
* Each method or function should be documented in the FUNCTIONS or METHODS
section,
and the POD for each method or function should placed directly above
where it is defined.
- * the INHERITENCE section might look something like this (taken from
Mail::Box)
- Mail::Box
- is a Mail::Reporter
+ * the INHERITENCE section might look something like this (taken from
Haver::Server::Object)
+ Haver::Server::Object extends L<Haver::Base>.
- Mail::Box is extended by
- Mail::Box::Dir
- Mail::Box::File
- Mail::Box::Net
* If longer cookbook-style examples need to be given, use a
"Module/Name/Cookbook.pod" file
for them. Try to keep SYNOPSIS under 20 lines. This is not a hard limit.
Modified: trunk/main/server/lib/Haver/Server/Object/Channel.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Object/Channel.pm 2005-01-01
07:43:59 UTC (rev 503)
+++ trunk/main/server/lib/Haver/Server/Object/Channel.pm 2005-01-01
09:01:10 UTC (rev 504)
@@ -1,38 +1,87 @@
-# Haver::Server::Object::Channel - OO representation of a channel.
-#
-# 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
+# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
+# This module is copyrighted, see end of file for details.
+=head1 NAME
+
+Haver::Server::Object::Channel - a Server::Object that contains
Server::Objects.
+
+=head1 INHERITENCE
+
+ Haver::Server::Object::Channel
+ is a Haver::Server::Object
+
+=head1 SYNOPSIS
+
+ use Haver::Server::Object::Channel;
+ # FIXME
+
+=head1 DESCRIPTION
+
+FIXME
+
+=cut
+
package Haver::Server::Object::Channel;
use strict;
use warnings;
use Haver::Server::Object;
-use Haver::Server::Object::Index;
use base qw( Haver::Server::Object );
-our $VERSION = 0.09;
+our $VERSION = 0.10;
+sub initialize {
+ my ($me) = @_;
+
+ $me->SUPER::initialize;
+ $me->{_contents} = {};
+}
+
sub namespace {
return 'channel';
}
+sub add {
+ my ($me, $object) = @_;
+
+ my $ns = $object->namespace;
+ my $id = $object->id;
+
+ croak ref($me) . " can't contain $object!" unless
$me->can_contain($object);
+
+ $me->{_contents}{$ns}{$id} = $object;
+}
+
+sub fetch {
+ my ($me, $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) = @_;
+
+ 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} };
+ }
+
+ return wantarray ? @values : [EMAIL PROTECTED];
+}
+
sub can_contain {
- my ($me, $obj) = @_;
+ my ($me, $object) = @_;
- !$obj->isa(__PACKAGE__);
+ not $object->isa(__PACKAGE__);
}
Modified: trunk/main/server/lib/Haver/Server/Object.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Object.pm 2005-01-01 07:43:59 UTC
(rev 503)
+++ trunk/main/server/lib/Haver/Server/Object.pm 2005-01-01 09:01:10 UTC
(rev 504)
@@ -1,20 +1,21 @@
-# Haver::Server::Object - OO Channel/User/etc base class.
-#
-# 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
+# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
+# This module is copyrighted, see end of file for details.
+
+=head1 NAME
+
+Haver::Server::Object - Base class for Users and Channels.
+
+=head1 SYNOPSIS
+
+ use Haver::Server::Object;
+ # FIXME
+
+=head1 DESCRIPTION
+
+FIXME
+
+=cut
+
package Haver::Server::Object;
use strict;
use warnings;
@@ -28,220 +29,143 @@
use File::Spec;
use File::Path ();
-# Subclass Haver::Savable
use base 'Haver::Base';
-use overload (
- '==' => 'equals',
- '""' => 'as_string',
- fallback => 1,
-);
-# Flags:
-# p = persistent : saved in userfile
-# l = locked : user can't change
-# i = indexed : shows up indexing operations.
+=head1 INHERITENCE
-# Public variables:
-our $RELOAD = 1;
-our $VERSION = 0.04;
-our $StorageDir ||= './store';
+Haver::Server::Object extends L<Haver::Base>.
+=head1 METHODS
-our %Types = (
- # '' => 'public',
- '+' => 'broadcast',
- '.' => 'private',
- '_' => 'secret',
- '-' => 'flag',
- '@' => 'attrib',
-);
+Haver::Server::Object supports the following methods:
-# Private class variables:
-# We use ||= instead of = so that this module may be reloaded.
-my $ID ||= 1;
+=head2 new(%params | \%params)
+This is the constructor, inherited from L<Haver::Base>.
+The parameter "id" is required.
-### Class methods.
-sub field_type {
- my ($this, $f) = @_;
- my ($char) = $f =~ /^([^a-zA-Z0-9])/;
+=cut
- if (defined $char) {
- return $Types{$char};
- } else {
- return 'public';
- }
-}
-
-sub namespace { 'object' }
-
-
-### Object methods
sub initialize {
- my ($me) = @_;
+ my ($me) = @_;
- $me->SUPER::initialize();
+ croak "required paramter: id" unless $me->{id};
+ $me->{_attribs} = { };
+}
- $me->{_objects} = {};
- $me->{_fields} = {};
- $me->{id} ||= $ID++;
+=head2 id(Z<>)
- my @ns = @{ (delete $me->{namespaces}) || [] };
+Returns the id (name) of the object.
- foreach my $ns (@ns) {
- $me->{".$ns"} = {};
- }
-
- return $me;
-}
+=cut
-
-## Accessor methods.
sub id {
- my ($me) = @_;
+ my ($me) = @_;
- return $me->{id};
+ return $me->{id};
}
-sub _val {
- return $_[0] if not ref $_[0];
-
- if (ref($_[0]) eq 'CODE') {
- return $_[0]->($_[1]);
- } else {
- return $_[0];
- }
-}
+=head2 namespace(Z<>)
-## Operator overload methods
-sub equals {
- my ($me, $what) = @_;
- return undef unless $what->can('namespace') && $what->can('id');
- return (($me->namespace eq $what->namespace) and ($me->id eq
$what->id));
-}
+Returns the namespace of the object.
-sub has_namespace {
- my ($me, $ns) = @_;
- return exists $me->{".$ns"};
-}
+This method B<must> be implemented by subclasses.
-sub namespaces {
- my ($me) = @_;
- my @ns = ();
+=head2 set($key, $val)
- @ns = grep(s/^\.//, keys %{ $me });
+Set the attribute C<$key> to C<$val> on the current object.
- return wantarray ? @ns : [EMAIL PROTECTED];
-}
+=cut
-sub add {
- my ($me, $object) = @_;
- my $id = lc $object->id;
- my $ns = $object->namespace;
-
- if (not($me->contains($ns, $id)) && $me->can_contain($object)) {
- $me->{".$ns"}{$id} = $object;
- $me->{".$ns"}{$id}
- } else {
- return undef;
- }
+sub set {
+ my ($me, $key, $val) = @_;
+ croak "Too few args!" if @_ < 3;
+ croak "Too many args, use set_many!" if @_ > 3;
+
+ $me->{_attribs}{$key} = $val;
}
-sub fetch {
- my ($me, $ns, $id) = @_;
- if (@_ != 3) {
- croak "fetch must be called with exactly three arguments!";
- }
+=head2 get($key)
- return $me->{".$ns"}{lc $id} if $me->contains($ns, $id);
-}
+Returns the value of the attribute C<$key>.
-sub contains {
- my ($me, $ns, $id) = @_;
- if (@_ != 3) {
- croak "contains must be called with exactly three arguments!";
- }
+=cut
- $id = lc $id;
- delete $me->{".$ns"}{$id} unless defined $me->{".$ns"}{$id};
- return exists $me->{".$ns"}{$id};
+sub get {
+ my ($me, $key) = @_;
+
+ croak "Too few args!" if @_ < 1;
+ croak "Too many args, try get_many!" if @_ > 1;
+
+ if (exists $me->{_attribs}{$key}) {
+ return $me->{_attribs}{$key};
+ } else {
+ return undef;
+ }
}
-sub remove {
- my $me = shift;
- my ($ns, $id);
-
- if (@_ == 1 && ref $_[0]) {
- my $o = $_[0];
- $ns = $o->namespace;
- $id = $o->id;
- } elsif (@_ == 2) {
- ($ns, $id) = @_;
- } else {
- die "Wrong number of arguments.";
- }
- delete $me->{".$ns"}{lc $id};
-}
+=head2 get_many(@keys)
-sub list_ids {
- my ($me, $ns) = @_;
- my $h = $me->{".$ns"};
- my @v = map { $_->id } values %$h;
+In scalar context, returns an arrayref of values of each attribute
+in C<@keys>. In list context, returns a list of the same.
- wantarray ? @v : [EMAIL PROTECTED];
-}
+=cut
-sub list_vals {
- carp "->list_vals is deprecated!";
- shift->contents(@_);
-}
+sub get_many {
+ my $me = shift;
+ my @ret = ();
+ my $f = $me->{_attribs};
-sub contents {
- my ($me, $ns) = @_;
- my $h = $me->{".$ns"};
+ foreach my $key (@_) {
+ push @ret, exists $f->{$key} ? $f->{$key} : undef;
+ }
- wantarray ? values %$h : [ values %$h ];
+ return wantarray ? @ret : [EMAIL PROTECTED] ;
}
-sub can_contain {
- # Can contain anything, really.
- 1;
-}
+=head2 del($key)
+Remove the attribute C<$key> and return it.
+=cut
+sub del {
+ my ($me, $key) = @_;
+ croak "Too few args" if @_ < 2;
+ croak "Too many args" if @_ > 2;
-1;
-=head1 NAME
+ delete $me->{_attribs}{$key};
+}
-Haver::Server::Object - Base class for Users and Channels.
+=head2 has($key)
-=head1 SYNOPSIS
+Returns true if the attribute C<$key> is set, false otherwise.
- use Haver::Server::Object;
- # FIXME.
+=cut
-=head1 DESCRIPTION
+sub has {
+ my ($me, $key) = @_;
+ croak "Too few args!" if @_ < 2;
+ croak "Too many args!" if @_ > 2;
-FIXME
+ return exists $me->{_attribs}{$key};
+}
-=head1 METHODS
-
-FIXME
+1;
=head1 SEE ALSO
-L<Haver::Server::User>, L<Haver::Server::Channel>.
+L<Haver::Server::Object::User>, L<Haver::Server::Object::Channel>.
=head1 AUTHOR
Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
-=head1 COPYRIGHT AND LICENSE
+=head1 COPYRIGHT and LICENSE
-Copyright (C) 2003-2004 by Dylan William Hardison
+Copyright (C) 2004, 2005 by Dylan 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
@@ -256,5 +180,3 @@
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
-
-=cut
