Author: dylan
Date: 2005-01-01 02:31:33 -0500 (Sat, 01 Jan 2005)
New Revision: 502
Modified:
trunk/clients/termvisual/termvisual.pl
trunk/dev-tools/do-haver-snapshots
trunk/docs/manual/chap/events.texi
trunk/main/server/lib/Haver/Server/Object.pm
Log:
termvisual client now uses the current Haver::Config and Haver::Config
has a different, not yet documented, API.
Modified: trunk/clients/termvisual/termvisual.pl
===================================================================
--- trunk/clients/termvisual/termvisual.pl 2005-01-01 06:23:27 UTC (rev
501)
+++ trunk/clients/termvisual/termvisual.pl 2005-01-01 07:31:33 UTC (rev
502)
@@ -18,6 +18,7 @@
use Curses;
use Haver::Protocol;
use Haver::Config;
+use Haver::OS;
my ($config, %ucommands, %scommands);
@@ -25,7 +26,7 @@
channel => 'bright cyan on black',
nick => 'white on black',
nickdecs => 'bright black on black',
- ncolor => 'bright white on black',
+ ncolor => 'white on black',
);
our %Bindings = (
@@ -52,10 +53,10 @@
sub handle_start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
- $heap->{config} = Haver::Config->new(
+ $heap->{config_handle} = Haver::Config->new(
file => "config",
default => {
- UID => 'blah' || 'A_User',
+ UID => Haver::OS->current_user,
Channel => 'lobby',
HistSize => 50,
BufferSize => 1000,
@@ -64,6 +65,7 @@
CommandChars => '/.',
},
);
+ $heap->{config} = $heap->{config_handle}->config;
$heap->{vt} = Term::Visual->new( Alias => "user_interface" );
@@ -91,7 +93,7 @@
sub handle_shutdown {
my ($kernel, $heap) = @_[KERNEL, HEAP];
- $heap->{config}->save;
+ $heap->{config_handle}->save;
$heap->{vt}->delete_window($heap->{window_id});
$heap->{vt}->shutdown;
exit;
Modified: trunk/dev-tools/do-haver-snapshots
===================================================================
--- trunk/dev-tools/do-haver-snapshots 2005-01-01 06:23:27 UTC (rev 501)
+++ trunk/dev-tools/do-haver-snapshots 2005-01-01 07:31:33 UTC (rev 502)
@@ -1,6 +1,5 @@
#!/bin/zsh
-
home=/home/dylan/src/Haver/download/snapshots/
base=file:///var/svn
Modified: trunk/docs/manual/chap/events.texi
===================================================================
--- trunk/docs/manual/chap/events.texi 2005-01-01 06:23:27 UTC (rev 501)
+++ trunk/docs/manual/chap/events.texi 2005-01-01 07:31:33 UTC (rev 502)
@@ -28,8 +28,6 @@
send to each other.
@end ifnottex
-
-
@menu
* Connection Events:: How to connect, disconnect, and stay connected.
* Channel Events:: How to join and part channels.
Modified: trunk/main/server/lib/Haver/Server/Object.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Object.pm 2005-01-01 06:23:27 UTC
(rev 501)
+++ trunk/main/server/lib/Haver/Server/Object.pm 2005-01-01 07:31:33 UTC
(rev 502)
@@ -29,7 +29,7 @@
use File::Path ();
# Subclass Haver::Savable
-use base 'Haver::Savable';
+use base 'Haver::Base';
use overload (
'==' => 'equals',
@@ -48,8 +48,6 @@
our $StorageDir ||= './store';
-our $IdPattern ||= qr/&?[A-Za-z][A-Za-z0-9_'[EMAIL PROTECTED]/;
-our $NsPattern ||= qr/[a-z]+/;
our %Types = (
# '' => 'public',
'+' => 'broadcast',
@@ -85,8 +83,8 @@
$me->SUPER::initialize();
+ $me->{_objects} = {};
$me->{_fields} = {};
- $me->{_loc} = {};
$me->{id} ||= $ID++;
my @ns = @{ (delete $me->{namespaces}) || [] };
@@ -106,74 +104,6 @@
return $me->{id};
}
-sub filename {
- my ($me) = @_;
- return File::Spec->catfile($StorageDir, $me->namespace, $me->id);
-}
-
-sub directory {
- my ($me) = @_;
-
- return File::Spec->catdir($StorageDir, $me->namespace);
-}
-
-
-sub saved_ids {
- my ($me) = @_;
- my $dir = $me->directory;
- my $dh;
- opendir $dh, $dir or return ();
- my @dirs = readdir $dh;
- closedir $dh;
- return wantarray ? @dirs : [EMAIL PROTECTED];
-}
-
-## Methods for accessing fields.
-sub set {
- my ($me, @set) = @_;
-
- while (my ($k,$v) = splice(@set, 0, 2)) {
- $me->{_fields}{$k} = $v;
- }
-}
-
-sub lset {
- my ($me, $loc, @set) = @_;
-
- while (my ($k,$v) = splice(@set, 0, 2)) {
- $me->{_loc}{$loc}{$k} = $v;
- }
-}
-
-sub get {
- my ($me, @keys) = @_;
-
- if (@keys <= 1) {
- return _val($me->{_fields}{$keys[0]}, $me);
- }
- my @values;
-
- foreach my $key (@keys) {
- push(@values, _val($me->{_fields}{$key}, $me));
- }
-
- return wantarray ? @values : [EMAIL PROTECTED] ;
-}
-
-sub lget {
- my ($me, $loc, @keys) = @_;
-
- if (@keys <= 1) {
- return _val($me->{_loc}{$loc}{$keys[0]}, $me);
- }
- my @values;
-
- foreach my $key (@keys) {
- push(@values, _val($me->{_loc}{$loc}{$key}, $me));
- }
-
- return wantarray ? @values : [EMAIL PROTECTED] ;
-}
sub _val {
return $_[0] if not ref $_[0];
@@ -184,83 +114,6 @@
}
}
-sub has {
- my ($me, @keys) = @_;
-
- if (@keys <= 1) {
- return exists $me->{_fields}{$keys[0]};
- }
-
- foreach my $key (@keys) {
- unless (exists $me->{_fields}{$key}) {
- return undef;
- }
- }
-
- return 1;
-}
-sub del {
- my ($me, @keys) = @_;
-
- if (@keys <= 1) {
- return delete $me->{_fields}{$keys[0]};
- }
-
- foreach my $key (@keys) {
- delete $me->{_fields}{$key};
- }
-
-
- return 1;
-}
-sub list_fields {
- my ($me) = @_;
- return keys %{ $me->{_fields} };
-}
-
-
-
-sub _save_data {
- my ($me) = @_;
- my (%fields, %flags);
- my %data = (
- Class => ref($me),
- ID => $me->id,
- NS => $me->namespace,
- fields => \%fields,
- );
-
- foreach my $f ($me->list_fields) {
- $fields{$f} = $me->{_fields}{$f};
- }
-
- File::Path::mkpath($me->directory);
- return \%data;
-}
-
-sub _init_data {
- my ($me) = @_;
-
- $me->{_fields} = (delete $me->{'-default'}{fields}) || {};
- delete $me->{'-default'};
-
- 1;
-}
-
-sub _load_data {
- my ($me, $data) = @_;
-
- no warnings;
- ASSERT: $data->{ID} eq $me->id;
- ASSERT: $data->{NS} eq $me->namespace;
- ASSERT: $data->{Class} eq ref($me);
- use warnings;
-
- %{$me->{_fields}} = (%{$me->{_fields}}, %{delete $data->{fields}});
-
- 1;
-}
-
## Operator overload methods
sub equals {
my ($me, $what) = @_;
@@ -268,59 +121,11 @@
return (($me->namespace eq $what->namespace) and ($me->id eq
$what->id));
}
-sub as_string {
- my ($me) = @_;
-
- return $me->namespace . '/' . $me->id;
-}
-
-
-sub write_file {
- my ($me, $file, $data) = @_;
- Storable::nstore($data, $file);
-}
-
-sub read_file {
- my ($me, $file) = @_;
- Storable::retrieve($file);
-}
-
-
-
sub has_namespace {
my ($me, $ns) = @_;
return exists $me->{".$ns"};
}
-sub is_valid_id {
- my ($this, $id) = @_;
-
- return 1 if $id eq '&';
- if (defined $id && ($id =~ /^$IdPattern$/)) {
- if (length($id) > 2 and length($id) < 20) {
- return 1;
- } else {
- return 0;
- }
- } else {
- return 0;
- }
-}
-
-sub is_valid_ns {
- my ($this, $ns) = @_;
-
- if (defined $ns && $ns =~ /^$NsPattern$/) {
- if (length($ns) > 2 and length($ns) < 20) {
- return 1;
- } else {
- return 0;
- }
- } else {
- return 0;
- }
-}
-
sub namespaces {
my ($me) = @_;
my @ns = ();
