Author: dylan
Date: 2004-06-15 15:32:26 -0400 (Tue, 15 Jun 2004)
New Revision: 238
Removed:
trunk/guile/
trunk/main/common/lib/Haver/Singleton.pm
Modified:
trunk/main/client/lib/Haver/Client/Command.pm
trunk/main/common/lib/Haver/Base.pm
trunk/main/common/lib/Haver/Config.pm
trunk/main/common/lib/Haver/Preprocessor.pm
trunk/main/common/lib/Haver/Protocol.pm
trunk/main/common/lib/Haver/Savable.pm
trunk/main/server/bin/haverd.pl
trunk/main/server/lib/Haver/Server/Object.pm
trunk/main/server/lib/Haver/Server/Object/User.pm
trunk/main/server/lib/Haver/Server/POE.pm
trunk/main/server/lib/Haver/Server/POE/Commands.pm
trunk/main/server/lib/Haver/Server/POE/Connection.pm
trunk/main/server/lib/Haver/Server/Registry.pm
Log:
removing the guile dir.
Modified: trunk/main/client/lib/Haver/Client/Command.pm
===================================================================
--- trunk/main/client/lib/Haver/Client/Command.pm 2004-06-14 22:47:42 UTC
(rev 237)
+++ trunk/main/client/lib/Haver/Client/Command.pm 2004-06-15 19:32:26 UTC
(rev 238)
@@ -19,11 +19,16 @@
use strict;
use warnings;
+use Carp qw(croak confess carp);
+
+use Haver::Preprocessor;
use Text::ParseWords (); # we use parse_line.
use Haver::Base;
use base 'Haver::Base';
+use Scalar::Util ();
+
our $VERSION = '0.01';
sub initialize {
@@ -37,13 +42,56 @@
$me->{alias} ||= {};
$me->{vars} ||= {};
$me->{command} ||= {};
- $me->{command}{say} ||= 1;
}
-sub process {
+sub invoke {
+ my ($me, $cmd, @args) = @_;
+
+ if (exists $me->{command}{$cmd} and exists
$me->{command}{$cmd}{handler}) {
+ $me->{command}{$cmd}{handler}->(@args);
+ }
+}
+
+sub parse_args {
+ my ($me, $cmd, $arg) = @_;
+
+ if (exists $me->{command}{$cmd} and exists
$me->{command}{$cmd}{parser}) {
+ return $me->{command}{$cmd}{parser}->($cmd, $arg);
+ }
+}
+
+sub run_callback {
+ my ($me, $cb, $args) = @_;
+
+ if (not ref $args) {
+ $args = [];
+ }
+ ASSERT: ref $cb;
+ my $ref = ref $cb;
+ if ($ref eq 'CODE') {
+ return $cb->(@$args);
+ } elsif (Scalar::Util::blessed($cb)) {
+ return $cb->invoke(@$args);
+ } elsif ($ref eq 'ARRAY') {
+ my $c = shift @$cb;
+ if (Scalar::Util::blessed($c)) {
+ my $method = shift @$cb;
+ return $c->$method(@$cb, @$args);
+ } elsif (ref $c eq 'CODE') {
+ return $c->(@$cb, @$args);
+ } else {
+ confess "I don't know how I got here!";
+ }
+ } else {
+ confess "I don't know how I got here!";
+ }
+}
+
+
+sub input {
my ($me, $s) = @_;
- my ($cmd, $arg) = $me->parse($s);
+ my ($cmd, $arg) = $me->parse_command($s);
my $result = $me->resolve_command($cmd);
die "Unknown command: $cmd" unless defined $result;
@@ -54,28 +102,20 @@
my @lines = $me->eval_text($me->{alias}{$cmd}, $arg);
foreach my $line (@lines) {
- $me->process($line);
+ $me->input($line);
}
} else {
my @args;
if ($cmd eq $me->{builtin_cmd}) {
$arg =~ s/^\s*(\w+)\s+//;
$cmd = $1;
- @args = $me->parse_args($cmd, $arg);
- } else {
- @args = $me->parse_args($cmd, $arg);
}
+ @args = $me->parse_args($cmd, $arg);
$me->invoke($cmd, @args);
}
}
-sub invoke {
- my ($me, $cmd, @args) = @_;
- use Data::Dumper;
- print Dumper({$cmd, [EMAIL PROTECTED]);
-}
-
-sub parse {
+sub parse_command {
my ($me, $s) = @_;
my $c = quotemeta $me->{chars};
my ($cmd, $arg);
@@ -91,17 +131,6 @@
return ($cmd, $arg);
}
-sub parse_args {
- my ($me, $cmd, $arg) = @_;
-
- if (my $code = $me->can("args_$cmd")) {
- return $code->($me, $arg);
- } else {
- return $me->default_args($cmd, $arg);
- }
-
-}
-
sub resolve_command {
my ($me, $prefix) = @_;
my $len = length $prefix;
@@ -126,40 +155,6 @@
}
}
-# This is called when there is no args_$cmd function.
-sub default_args {
- my ($me, $cmd, $arg) = @_;
- $arg =~ s/^\s+//;
- $arg =~ s/\s+$//;
- return ($arg);
-}
-
-sub args_msg {
- my ($me, $arg) = @_;
- $arg =~ s/^\s*(\S+)\s+//;
-
- return ($1, $arg);
-}
-
-sub args_raw {
- my ($me, $arg) = @_;
- my @args = grep(defined, Text::ParseWords::parse_line(qr/\s+/, 0,
$arg));
- return (@args);
-}
-
-sub args_alias {
- my ($me, $arg) = @_;
- $arg =~ s/^\s*(\w+)\s+//;
-
- return ($1, $arg);
-}
-
-sub args_builtin {
- my ($me, $arg) = @_;
-
- return ($1, $arg);
-}
-
### Methods for manipulating aliases.
sub aliases {
my ($me) = @_;
@@ -252,8 +247,8 @@
}
sub register {
- my ($me, $cmd) = @_;
- $me->{command}{$cmd} = 1;
+ my ($me, $cmd, %opt) = @_;
+ $me->{command}{$cmd} = \%opt;
}
sub unregister {
Modified: trunk/main/common/lib/Haver/Base.pm
===================================================================
--- trunk/main/common/lib/Haver/Base.pm 2004-06-14 22:47:42 UTC (rev 237)
+++ trunk/main/common/lib/Haver/Base.pm 2004-06-15 19:32:26 UTC (rev 238)
@@ -25,6 +25,7 @@
sub new {
my $this = shift;
+ ASSERT: @_ == 1 || (@_ % 2) == 0;
my $me = @_ == 1 && ref($_[0]) ? shift : { @_ };
my $type = ref $me;
bless $me, ref($this) || $this;
Modified: trunk/main/common/lib/Haver/Config.pm
===================================================================
--- trunk/main/common/lib/Haver/Config.pm 2004-06-14 22:47:42 UTC (rev
237)
+++ trunk/main/common/lib/Haver/Config.pm 2004-06-15 19:32:26 UTC (rev
238)
@@ -22,7 +22,7 @@
use Haver::Savable;
use Haver::OS;
-use base 'Haver::Savable';
+use base qw(Haver::Savable);
use YAML ();
use Fatal qw(:void open close);
use File::stat;
Modified: trunk/main/common/lib/Haver/Preprocessor.pm
===================================================================
--- trunk/main/common/lib/Haver/Preprocessor.pm 2004-06-14 22:47:42 UTC (rev
237)
+++ trunk/main/common/lib/Haver/Preprocessor.pm 2004-06-15 19:32:26 UTC (rev
238)
@@ -17,12 +17,11 @@
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
package Haver::Preprocessor;
use strict;
-use warnings;
+#use warnings;
use Carp;
use Filter::Simple;
-our ($ASSERT, $DUMP, $DEBUG, $IF, $VERBOSE);
-$IF = 1;
+our ($ASSERT, $DUMP, $DEBUG, $IF, $VERBOSE, $Did);
FILTER {
if ($ASSERT) {
@@ -50,9 +49,26 @@
}
};
+sub import {
+ my ($class, @args) = @_;
+
+ no strict 'refs';
+ foreach my $arg (@args) {
+ if ($arg =~ s/^://) {
+ ${uc($arg)}++;
+ }
+ }
+
+ if ($VERBOSE and not $Did++) {
+ show("ASSERT = %s, DUMP = %s, DEBUG = %s, IF = %s\n",
+ what($ASSERT), what($DUMP), what($DEBUG), what($IF));
+ }
+}
+
sub doif {
my $cond = shift;
- my $v = eval "$cond";
+ no strict;
+ my $v = eval "package main; $cond";
if ($@) {
my $s = "$@";
@@ -61,17 +77,14 @@
}
if ($v) {
- return 'if (1) {';
+ return '{';
} else {
return 'if (0) {';
}
}
-if ($VERBOSE) {
- show("ASSERT = %s, DUMP = %s, DEBUG = %s, IF = %s\n",
- what($ASSERT), what($DUMP), what($DEBUG), what($IF));
-}
+
sub show {
my $fmt = shift;
print STDERR __PACKAGE__, ": ", sprintf($fmt, @_);
Modified: trunk/main/common/lib/Haver/Protocol.pm
===================================================================
--- trunk/main/common/lib/Haver/Protocol.pm 2004-06-14 22:47:42 UTC (rev
237)
+++ trunk/main/common/lib/Haver/Protocol.pm 2004-06-15 19:32:26 UTC (rev
238)
@@ -89,14 +89,11 @@
foreach (@event) {
$_ = escape($_);
}
-
join("\t", @event) . $CRLF;
}
1;
-
-1;
__END__
=head1 NAME
Modified: trunk/main/common/lib/Haver/Savable.pm
===================================================================
--- trunk/main/common/lib/Haver/Savable.pm 2004-06-14 22:47:42 UTC (rev
237)
+++ trunk/main/common/lib/Haver/Savable.pm 2004-06-15 19:32:26 UTC (rev
238)
@@ -17,15 +17,15 @@
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
package Haver::Savable;
use strict;
+use Haver::Preprocessor;
#use warnings;
-use base 'Haver::Base';
+use base qw( Haver::Base );
use YAML ();
use Fatal qw(:void open close);
use File::stat ();
use File::Basename ();
use File::Path ();
-use Haver::Preprocessor;
use Carp;
our $VERSION = '0.02';
@@ -46,22 +46,32 @@
DEBUG: "Loading $me";
ASSERT: defined $filename;
if (-e $filename) {
- local $/ = undef;
- open $fh, $filename;
- my $raw = readline $fh; # slurp in file
+ my $raw = _slurp($filename);
my $data = YAML::Load($raw);
- close $fh;
+ $me->_init_data;
$me->{_mtime} = File::stat::populate(CORE::stat(_))->mtime;
- $me->_init_data;
return $me->_load_data($data);
} else {
+ $me->_init_data;
$me->{_mtime} = time;
- $me->_init_data;
return undef;
}
}
+
+# This slurps in the entire file.
+sub _slurp {
+ my ($file) = @_;
+ my $fh;
+ open $fh, $file;
+ local $/ = undef;
+ my $data = readline $fh;
+ close $fh;
+
+ return $data;
+}
+
sub _init_data {
}
Deleted: trunk/main/common/lib/Haver/Singleton.pm
===================================================================
--- trunk/main/common/lib/Haver/Singleton.pm 2004-06-14 22:47:42 UTC (rev
237)
+++ trunk/main/common/lib/Haver/Singleton.pm 2004-06-15 19:32:26 UTC (rev
238)
@@ -1,97 +0,0 @@
-# Haver::Singleton
-#
-# 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::Singleton;
-use strict;
-use warnings;
-
-our $VERSION = '0.03';
-use base 'Haver::Base';
-
-sub new {
- die "Never call 'new' on a singleton class! ($_[0])"
-}
-sub _new_instance {
- my $this = shift;
- return $this->SUPER::new(@_);
-}
-sub instance {
- my $this = shift;
- my $class = ref($this) || $this;
-
- no strict 'refs';
- my $self = "${class}::__INSTANCE__";
-
-
- if (${$self}) {
- return ${$self};
- } else {
- return ${$self} = $this->_new_instance(@_);
- }
-
-}
-1;
-__END__
-
-=head1 NAME
-
-Haver::Singleton - Base class for singleton classes.
-
-=head1 SYNOPSIS
-
- use Haver::Singleton (@args);
- my $one = instance Haver::Singleton (@args);
- my $another = instance Haver::Singleton (@args); # Same as $one.
-
-=head1 DESCRIPTION
-
-This is the base class for all singleton objects in Haver server and the haver
clients.
-It is derived from Haver::Base.
-
-TODO: document methods, explain what a singleton object is, explain
-how import() is used for default arguments to instance(). Explain instance(),
-and how/why new() is not to be used.
-
-=head1 SEE ALSO
-
-L<Haver::Singleton>
-
-L<https://gna.org/projects/haver/>
-
-=head1 AUTHOR
-
-Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2004 by Dylan William Hardison
-
-This library 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 library 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
-
-=cut
Modified: trunk/main/server/bin/haverd.pl
===================================================================
--- trunk/main/server/bin/haverd.pl 2004-06-14 22:47:42 UTC (rev 237)
+++ trunk/main/server/bin/haverd.pl 2004-06-15 19:32:26 UTC (rev 238)
@@ -18,15 +18,8 @@
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
use strict;
use warnings;
-BEGIN {
- $Haver::Preprocessor::ASSERT = 1;
- $Haver::Preprocessor::DUMP = 1;
- $Haver::Preprocessor::DEBUG = 2;
- $Haver::Preprocessor::VERBOSE = 1;
- $Haver::Preprocessor::IF = 1;
-}
-
-use Haver::Server;
+use Haver::Preprocessor qw( :verbose :assert :dump :debug );
+use Haver::Server::POE;
use Getopt::Long;
my $confdir = './conf';
my $datadir = './data';
@@ -37,7 +30,7 @@
);
-Haver::Server->boot(
+Haver::Server::POE->boot(
confdir => $confdir,
datadir => $datadir,
);
Modified: trunk/main/server/lib/Haver/Server/Object/User.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Object/User.pm 2004-06-14 22:47:42 UTC
(rev 237)
+++ trunk/main/server/lib/Haver/Server/Object/User.pm 2004-06-15 19:32:26 UTC
(rev 238)
@@ -24,13 +24,11 @@
use Haver::Server::Object;
use Haver::Server::Object::Index;
use Haver::Server::Globals qw( $Config );
-
use base qw( Haver::Server::Object Haver::Server::Object::Index );
+our $VERSION = 0.05;
-our $VERSION = '0.04';
-
sub initialize {
my ($me) = @_;
@@ -43,64 +41,16 @@
$me->set_flags('+role', 'lip');
-}
-sub may {
- my ($me, $act, %arg) = @_;
-
- if (ref $act) {
- foreach my $a (@$act) {
- $me->may($a, %arg) or return undef;
- }
- return 1;
- }
-
- if ($arg{scope}) {
- my $a = "$arg{scope}:$act";
- return $me->{_access}{$a} if exists $me->{_access}{$a};
- }
- return $me->{_access}{$act} if exists $me->{_access}{$act};
-
- my $role = do {
- if ($arg{scope} && $me->has("+$arg{scope}:role")) {
- $me->get("+$arg{scope}:role");
- } else {
- $me->get('+role');
- }
- };
-
- return $Config->{Roles}{$role}{$act} if exists
$Store->{Roles}{$role}{$act};
- return undef;
}
-sub grant {
- my ($me, $act, %arg) = @_;
- my $key = $arg{scope} ? "$arg{scope}:$act" : $act;
-
- $me->{_access}{$key} = 1;
-}
-sub wipe {
- my ($me, $act, %arg) = @_;
-
- my $key = $arg{scope} ? "$arg{scope}:$act" : $act;
- delete $me->{_access}{$key};
-}
-
-sub revoke {
- my ($me, $act, %arg) = @_;
-
- my $key = $arg{scope} ? "$arg{scope}:$act" : $act;
- $me->{_access}{$key} = 0;
-}
-
-
sub _save_data {
my ($me) = @_;
my $data = $me->SUPER::_save_data();
- $data->{access} = $me->{_access};
+ #$data->{access} = $me->{_access};
return $data;
}
@@ -108,7 +58,7 @@
sub _load_data {
my ($me, $data) = @_;
$me->SUPER::_load_data($data);
- $me->{_access} = $data->{access};
+ #$me->{_access} = $data->{access};
return 1;
}
Modified: trunk/main/server/lib/Haver/Server/Object.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Object.pm 2004-06-14 22:47:42 UTC
(rev 237)
+++ trunk/main/server/lib/Haver/Server/Object.pm 2004-06-15 19:32:26 UTC
(rev 238)
@@ -44,8 +44,9 @@
# i = indexed : shows up indexing operations.
# Public variables:
-our $RELOAD = 1;
-our $VERSION = "0.04";
+our $RELOAD = 1;
+our $VERSION = 0.04;
+our $StorageDir ||= './store';
our %Flags = (
broadcast => 'pi',
@@ -68,7 +69,6 @@
# Private class variables:
# We use ||= instead of = so that this module may be reloaded.
my $ID ||= 1;
-my $StoreDir ||= './store';
### Class methods.
@@ -83,17 +83,6 @@
}
}
-sub store_dir {
- my ($class, $dir) = @_;
- ASSERT: not ref $class;
-
- if (@_ == 1) {
- return $StoreDir;
- } else {
- return $StoreDir = $dir;
- }
-}
-
sub namespace { 'object' }
@@ -124,13 +113,14 @@
sub filename {
my ($me) = @_;
- return File::Spec->catfile($StoreDir, $me->namespace, $me->id);
+ return File::Spec->catfile($StorageDir, $me->namespace, $me->id);
}
sub directory {
my ($me) = @_;
-
- return File::Spec->catdir($StoreDir, $me->namespace);
+ my ($vol, $dir) = File::Spec->splitpath($me->filename);
+
+ return $vol.$dir;
}
## Flag methods
Modified: trunk/main/server/lib/Haver/Server/POE/Commands.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/POE/Commands.pm 2004-06-14 22:47:42 UTC
(rev 237)
+++ trunk/main/server/lib/Haver/Server/POE/Commands.pm 2004-06-15 19:32:26 UTC
(rev 238)
@@ -217,7 +217,7 @@
$user->send(['MSG', $heap->{uid}, @$args]);
} else {
my @msg = ( 'MSG', $heap->{uid}, @$args );
- $kernel->post('Registry', 'broadcast',
$heap->{scope}{uid}, @msg);
+ $kernel->post('Registry', 'broadcast',
$heap->{scope}{uid}, [EMAIL PROTECTED]);
}
} else {
return unless check_perm_access($heap->{user}, 'global msg');
Modified: trunk/main/server/lib/Haver/Server/POE/Connection.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/POE/Connection.pm 2004-06-14
22:47:42 UTC (rev 237)
+++ trunk/main/server/lib/Haver/Server/POE/Connection.pm 2004-06-15
19:32:26 UTC (rev 238)
@@ -30,15 +30,15 @@
);
use Haver::Protocol;
-use Haver::Server::Globals qw( $Registry $Config );
-use Haver::Server::Connection::Commands;
+use Haver::Server::POE::Commands;
use Digest::SHA1 qw( sha1_base64 );
our $RELOAD = 1;
+
sub create {
my ($class, @args) = @_;
- my $C = "Haver::Server::Connection::Commands";
+ my $C = "Haver::Server::POE::Commands";
POE::Session->create(
package_states => [
@@ -133,8 +133,8 @@
if ($event =~ s/^cmd_//) {
my $cmd = "cmd_$event";
- if (my $code = Haver::Server::Commands->can($cmd)) {
- $kernel->state($cmd, 'Haver::Server::Commands');
+ if (my $code = Haver::Server::POE::Commands->can($cmd)) {
+ $kernel->state($cmd, 'Haver::Server::POE::Commands');
@_[ARG0 .. $#_] = @{ $_[ARG1] };
goto &$code;
} else {
Modified: trunk/main/server/lib/Haver/Server/POE.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/POE.pm 2004-06-14 22:47:42 UTC (rev
237)
+++ trunk/main/server/lib/Haver/Server/POE.pm 2004-06-15 19:32:26 UTC (rev
238)
@@ -41,7 +41,7 @@
},
);
-use Haver::Server::Listener;
+use Haver::Server::POE::Listener;
use Haver::Server::Registry;
use Haver::Server::Object::Channel;
use Haver::Server::Object::User;
@@ -62,6 +62,7 @@
ASSERT: $opts{confdir};
ASSERT: $opts{datadir};
+ DEBUG: "Booting ", __PACKAGE__;
$Config = instance Haver::Config(
file => "$opts{confdir}/config.yml"
@@ -69,16 +70,13 @@
$Registry = instance Haver::Server::Registry;
- eval {
+ if ($Config->{Feature}{IKC}) {
require POE::Component::IKC::Server;
import POE::Component::IKC::Server;
- };
- unless ($@) {
create_ikc_server(
ip => $Config->{IKC}{Host} || 'localhost',
port => $Config->{IKC}{Port} || '4040',
name => $Config->{IKC}{Name} || 'HaverServer',
- a
);
}
@@ -86,22 +84,11 @@
Haver::Reload->init;
$Config->{Server}{PingTime} ||= 60;
Haver::Server::Object->store_dir( "$opts{datadir}/store" );
-
-
- foreach my $cid (@{ $Store->{Channels} }) {
- my $chan = new Haver::Server::Object::Channel(id => $cid);
- eval { $chan->load };
- if ($@) {
- warn "Can't load $cid.\n$@";
- }
- $chan->set(_perm => 1);
- $Registry->add($chan);
- }
-
+
$this->create;
- $poe_kernel->run();
}
+
sub create {
my ($class) = @_;
POE::Session->create(
Modified: trunk/main/server/lib/Haver/Server/Registry.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Registry.pm 2004-06-14 22:47:42 UTC
(rev 237)
+++ trunk/main/server/lib/Haver/Server/Registry.pm 2004-06-15 19:32:26 UTC
(rev 238)
@@ -20,65 +20,31 @@
#use warnings;
use Haver::Preprocessor;
-use Haver::Singleton;
use Haver::Server::Object::Index;
-use Haver::Server::Globals qw( %Feature );
-use base qw( Haver::Singleton Haver::Server::Object::Index );
+use base qw( Haver::Server::Object Haver::Server::Object::Index );
use POE;
-our $VERSION = '0.03';
+our $VERSION = 0.04;
our $RELOAD = 1;
-sub initialize {
- my ($me) = @_;
-
-
- POE::Session->create(
- object_states => [
- $me => {
- _start => 'on_start',
- _stop => 'on_stop',
- map { ($_ => "on_$_") } qw(
- broadcast
- ),
- },
- ],
- );
+sub namespace {
+ 'registry',
}
-
-
-
-sub resolve {
- my ($me, $tag) = @_;
- my ($ns, $id) = split('/', $tag, 2);
- return undef unless defined $ns and defined $id;
-
- return $me->fetch($ns, $id);
+sub id {
+ 'registry',
}
-sub on_broadcast {
- my ($me, $kernel, $heap, $uids, $rest) = @_[OBJECT, KERNEL, HEAP, ARG0
.. $#_];
-
- foreach my $uid (@$uids) {
- my $u = $me->fetch('user', $uid);
- eval { $u->send($rest) };
- }
+sub filename {
+ my ($me) = @_;
+ return File::Spec->catfile($Haver::Server::Object::StorageDir,
$me->namespace);
}
-sub on_start {
- my ($me, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
- DEBUG: "Registry starts.";
- $kernel->alias_set('Registry');
-
- #if ($Feature{IKC}) {
- #}
+sub can_contain {
+ my ($me, $obj) = @_;
+
+ !$obj->isa(__PACKAGE__);
}
-sub on_stop {
- my ($me, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
- DEBUG: "Registry stops."
-}
-
1;
