Author: dylan
Date: 2005-05-07 21:41:23 -0400 (Sat, 07 May 2005)
New Revision: 672
Added:
trunk/main/core/lib/Haver/Base.pm
Removed:
trunk/main/core/lib/Haver/Formats.pm
trunk/main/core/lib/Haver/Logger.pm
trunk/main/core/lib/Haver/Logger/
trunk/main/core/lib/Haver/Object.pm
trunk/main/core/lib/Haver/Util/
trunk/main/server/lib/Haver/Server/Base.pm
Modified:
trunk/
trunk/main/core/lib/Haver/Protocol/Filter.pm
trunk/main/server/lib/Haver/Server/Broadcaster.pm
trunk/main/server/lib/Haver/Server/Listener.pm
trunk/main/server/lib/Haver/Server/Speaker.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-05-07 15:32:34 -0400
Removing cruft, moving Haver::Server::Base to Haver::Base.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 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:927
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 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:938
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Added: trunk/main/core/lib/Haver/Base.pm
===================================================================
--- trunk/main/core/lib/Haver/Base.pm 2005-04-25 00:49:04 UTC (rev 671)
+++ trunk/main/core/lib/Haver/Base.pm 2005-05-08 01:41:23 UTC (rev 672)
@@ -0,0 +1,46 @@
+# vim: set ts=4 sw=4 si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Base;
+use Spiffy qw( -Base );
+use Carp;
+
+our @EXPORT_BASE = qw( field croak carp confess );
+{
+no warnings;
+sub field(@) {
+ use warnings;
+ my $package = caller;
+ my ($args, @values) = do {
+ no warnings;
+ local *boolean_arguments = sub { (qw( -weak -force )) };
+ local *paired_arguments = sub { (qw( -package -init )) };
+ Haver::Server::Base->parse_arguments(@_);
+ };
+ my ($field, $default) = @values;
+ if (my $sub = $package->can($field) and not $args->{'-force'}) {
+ require B;
+ my $p = B::svref_2object($sub)->START->stashpv;
+ if ($p ne $package) {
+ croak "Warning: redefining field $field in $package (Previously
defined in $p)\n\t";
+ }
+ }
+ Spiffy::field (-package => $package, @_);}
+}
+
+sub new() {
+ my $this = shift;
+ my $self = super;
+
+ $self->initialize;
+
+ return $self;
+}
+
+sub DESTROY {
+ $self->finalize;
+}
+
+sub initialize { }
+sub finalize { }
+
+
Deleted: trunk/main/core/lib/Haver/Formats.pm
===================================================================
--- trunk/main/core/lib/Haver/Formats.pm 2005-04-25 00:49:04 UTC (rev
671)
+++ trunk/main/core/lib/Haver/Formats.pm 2005-05-08 01:41:23 UTC (rev
672)
@@ -1,79 +0,0 @@
-# Haver::Formats - Parsing and Formatting routines.
-#
-# 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::Formats;
-use strict;
-use warnings;
-
-use POSIX qw( strftime );
-#use Time::Duration qw( duration_exact concise );
-use Date::Parse qw( str2time );
-
-use Carp;
-use Exporter;
-use base 'Exporter';
-
-our @EXPORT_OK = qw(
- format_datetime parse_datetime
- check_id_valid check_id_reserved
-);
-our %EXPORT_TAGS = (
- 'datetime' => [qw( format_datetime parse_datetime )],
- 'check' => [qw( check_id_valid check_id_reserved )],
-);
-our $VERSION = 0.05;
-our $RELOAD = 1;
-our $IdPattern ||= qr/&?[A-Za-z][A-Za-z0-9_'[EMAIL PROTECTED]/;
-
-sub check_id_reserved {
- my $id = shift;
-
- return $id =~ /^&/ or $id =~ /@/;
- return 0;
-}
-
-sub check_id_valid {
- my $id = shift;
-
- return $id =~ $IdPattern;
-}
-
-# Author: dylan
-sub format_datetime {
- # dylan: Because bd_ thought it should work this way...
- # ASSERT: @_ <= 1;
- my $now = @_ ? shift : time;
-
- strftime('%Y-%m-%d %H:%M:%S', gmtime($now));
-}
-
-
-sub parse_datetime {
- # ASSERT: @_ == 1;
- my $str = shift;
- # patterns
- my $date = qr/(\d{4})-(\d\d)-(\d\d)/;
- my $time = qr/(\d\d):(\d\d):(\d\d)/;
-
- if ($str =~ /^$date $time$/) {
- return str2time($str);
- } else {
- croak "Datetime format is invalid!";
- }
-}
-
-1;
Deleted: trunk/main/core/lib/Haver/Logger.pm
===================================================================
--- trunk/main/core/lib/Haver/Logger.pm 2005-04-25 00:49:04 UTC (rev 671)
+++ trunk/main/core/lib/Haver/Logger.pm 2005-05-08 01:41:23 UTC (rev 672)
@@ -1,100 +0,0 @@
-# vim: set ts=4 sw=4 expandtab si ai sta tw=100:
-# This module is copyrighted, see end of file for details.
-package Haver::Logger;
-use strict;
-use warnings;
-use Carp;
-
-use base 'Haver::Object';
-
-our $VERSION = 0.04;
-
-sub initialize {
- my ($me, $p) = @_;
-
- $me->{outputs} = { };
-}
-
-
-sub add {
- my ($me, $logger) = @_;
- my $name;
-
-
- unless ($logger->can('log') and $logger->can('name')) {
- croak "Method add() must be passed an object which supports log() and
name() methods";
- }
-
- $name = $object->name;
-
- if (exists $me->{outputs}{$name}) {
- croak "Haver::Logger output with name $name already defined!";
- }
-
- $me->{outputs}{$name} = $object;
-}
-
-sub outputs {
- my ($me) = @_;
-
- return wantarray ?
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Haver::Logger - Haver subclass of L<Log::Dispatch>
-
-=head1 SYNOPSIS
-
- use Haver::Logger;
- # Small code example.
-
-=head1 DESCRIPTION
-
-This is a wrapper around L<Log::Dispatch>, making Log::Dispatch
-optional.
-
-=head1 INHERITENCE
-
-Haver::Logger extends L<Haver::Base>.
-
-=head1 METHODS
-
-Haver::Logger implements the following methods:
-
-
-
-=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
-
Deleted: trunk/main/core/lib/Haver/Object.pm
===================================================================
--- trunk/main/core/lib/Haver/Object.pm 2005-04-25 00:49:04 UTC (rev 671)
+++ trunk/main/core/lib/Haver/Object.pm 2005-05-08 01:41:23 UTC (rev 672)
@@ -1,148 +0,0 @@
-# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
-# This module is copyrighted, see end of file for details.
-package Haver::Object;
-use strict;
-use warnings;
-use Carp;
-
-use constant DEBUG => 1;
-
-our $VERSION = 0.08;
-
-
-sub new {
- my $class = shift;
- my $me = bless {}, $class;
- my $args;
-
- if (UNIVERSAL::isa($_[0], 'HASH')) {
- $args = $_[0];
- } elsif ((@_ % 2) == 0) {
- $args = { @_ };
- } else {
- croak "Odd number of parameters to new()";
- }
-
- if (DEBUG) {
- print "New: ", overload::StrVal($me), "\n";
- }
-
- $me->initialize($args);
-
- return $me;
-}
-
-sub DESTROY {
- my $me = shift;
-
- if (DEBUG) {
- print "Destroy: ", overload::StrVal($me), "\n";
- }
- $me->finalize();
-}
-
-sub initialize { return }
-sub finalize { return }
-
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-Haver::Object - Useful base class for most objects in Haver server and clients.
-
-=head1 SYNOPSIS
-
- BEGIN {
- package Foobar;
- use base 'Haver::Object';
-
- sub initialize {
- my ($me, $params) = @_;
- print "init args: join(', ', keys %$params), "\n";
- }
-
- sub finalize {
- my ($me) = @_;
- # do stuff here that you would do in DESTROY.
- }
- } # BEGIN
-
-=head1 DESCRIPTION
-
-This is a base class for nearly every class in the Haver server,
-and it is encouraged to be used for any class in the client, too.
-
-The main advantage it brings is not having to write redundant
-constructors, and also it prints debugging messages on object creation and
destruction.
-
-When a new object is instantiated, initialize() is called.
-Don't overload DESTROY in child classes, use finalize() instead.
-
-=head1 METHODS
-
-Haver::Object implements the following methods:
-
-=head2 new(%params || \%params)
-
-This constructor method creates and returns a new I<$class>,
-and passes %params to initialize().
-
-=head3 Parameters
-
-As a matter of style, parameters should begin with a single dash (-)
-and be all lower-case.
-
-Further, you should document parameters in a "PARAMETERS"
-section in the POD of the class. Place it right before "METHODS".
-
-=head1 VIRTUAL METHODS
-
-The following methods may be defined by subclasses:
-
-=head2 initialize($params)
-
-This is called by new(), and should be defined instead of new().
-
-The first argument, $params, is a hashref all any parameters passed to new().
-
-The return value is unimportant.
-
-=head2 finalize(Z<>)
-
-This method is called from DESTROY().
-
-You should overload this method instead of DESTROY(),
-so that the useful debugging messages are printed
-when objects are destroyed.
-
-=head1 SEE ALSO
-
-L<https://gna.org/projects/haver/>
-
-=head1 AUTHOR
-
-Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2004, 2005 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/core/lib/Haver/Protocol/Filter.pm
===================================================================
--- trunk/main/core/lib/Haver/Protocol/Filter.pm 2005-04-25 00:49:04 UTC
(rev 671)
+++ trunk/main/core/lib/Haver/Protocol/Filter.pm 2005-05-08 01:41:23 UTC
(rev 672)
@@ -1,5 +1,5 @@
# vim: set ft=perl ts=4 sw=4 sta si ai tw=100 expandtab:
-# POE::Filter::Haver
+# Haver::Protocol::Filter
# This is a POE filter for the Haver protocol.
# It subclasses POE::Filter::Line.
#
@@ -95,12 +95,12 @@
=head1 NAME
-POE::Filter::Haver - POE::Filter for the Haver protocol.
+Haver::Protocol::Filter - POE::Filter for the Haver protocol.
=head1 SYNOPSIS
- use POE::Filter::Haver;
- my $filter = new POE::Filter::Haver; # takes no arguments.
+ use Haver::Protocol::Filter;
+ my $filter = new Haver::Protocol::Filter; # takes no arguments.
# See POE::Filter. This is just a standard filter.
# it inherits from POE::Filter::Line.
Deleted: trunk/main/server/lib/Haver/Server/Base.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Base.pm 2005-04-25 00:49:04 UTC (rev
671)
+++ trunk/main/server/lib/Haver/Server/Base.pm 2005-05-08 01:41:23 UTC (rev
672)
@@ -1,48 +0,0 @@
-# vim: set ts=4 sw=4 si ai sta tw=100:
-# This module is copyrighted, see end of file for details.
-package Haver::Server::Base;
-use Spiffy qw( -Base );
-use Carp;
-
-our @EXPORT_BASE = qw( field croak carp confess );
-
-
-{
-no warnings;
-sub field(@) {
- use warnings;
- my $package = caller;
- my ($args, @values) = do {
- no warnings;
- local *boolean_arguments = sub { (qw( -weak -force )) };
- local *paired_arguments = sub { (qw( -package -init )) };
- Haver::Server::Base->parse_arguments(@_);
- };
- my ($field, $default) = @values;
- if (my $sub = $package->can($field) and not $args->{'-force'}) {
- require B;
- my $p = B::svref_2object($sub)->START->stashpv;
- if ($p ne $package) {
- croak "Warning: redefining field $field in $package (Previously
defined in $p)\n\t";
- }
- }
- Spiffy::field (-package => $package, @_);}
-}
-
-sub new() {
- my $this = shift;
- my $self = super;
-
- $self->initialize;
-
- return $self;
-}
-
-sub DESTROY {
- $self->finalize;
-}
-
-sub initialize { }
-sub finalize { }
-
-
Modified: trunk/main/server/lib/Haver/Server/Broadcaster.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Broadcaster.pm 2005-04-25 00:49:04 UTC
(rev 671)
+++ trunk/main/server/lib/Haver/Server/Broadcaster.pm 2005-05-08 01:41:23 UTC
(rev 672)
@@ -49,7 +49,6 @@
sub send {
my ($kernel, $heap, $target, $msg) = @_[KERNEL, HEAP, ARG0, ARG1];
- # ASSERT: ref($target) eq 'ARRAY' and ref($msg) eq 'ARRAY';
my $n = @$target;
my $end = $n > CHUNK ? CHUNK : $n;
my @targ = splice(@$target, 0, $end);
Modified: trunk/main/server/lib/Haver/Server/Listener.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Listener.pm 2005-04-25 00:49:04 UTC
(rev 671)
+++ trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-08 01:41:23 UTC
(rev 672)
@@ -24,7 +24,9 @@
shutdown
)],
],
- heap => {},
+ heap => {
+ acceptor => $opt{acceptor},
+ },
);
}
@@ -95,13 +97,12 @@
@_[KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3];
my $info = $heap->{listeners}{$wid}{iface};
- $heap->{acceptor}->(
+ $heap->{acceptor}->create(
sock => $socket,
address => Socket::inet_ntoa($address),
port => $port,
iface => $info,
);
-
}
sub socket_fail {
Modified: trunk/main/server/lib/Haver/Server/Speaker.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Speaker.pm 2005-04-25 00:49:04 UTC
(rev 671)
+++ trunk/main/server/lib/Haver/Server/Speaker.pm 2005-05-08 01:41:23 UTC
(rev 672)
@@ -1,72 +1,20 @@
-# Haver::Server::Speaker,
-# this creates a session, which represents the user...
-#
-# Copyright (C) 2003 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
-
-# TODO, write POD. Soon.
package Haver::Server::Speaker;
-use strict;
-use Carp qw(croak confess carp cluck);
-use POE qw(
- Wheel::ReadWrite
- Driver::SysRW
- Preprocessor
- Filter::Haver
-);
+use Haver::Server::Session '-Base';
+use POE::Wheel::ReadWrite;
+use POE::Driver::SysRW;
-use Haver::Server::Events;
-use Haver::Server::Registry qw( $Registry );
-our $RELOAD = 1;
-sub create {
- my ($class) = shift;
- # ASSERT: (@_ == 1 and ref($_[0]) eq 'HASH') or ((@_ % 2) == 0);
- my $opts = @_ == 1 ? $_[0] : { @_ };
+map { state "_$_" => "on_$_" } qw( start stop default );
+states qw(
+ input error flush
+ cleanup shutdown
+ fail oops
+);
- POE::Session->create(
- package_states => [
- $class => {
- # POE states
- _start => '_start',
- _stop => '_stop',
- _default => '_default',
-
-
- # Wheel states
- input => 'on_input',
- error => 'on_error',
- flush => 'on_flush',
-
- # Utility states
- cleanup => 'on_cleanup',
- 'shutdown' => 'on_shutdown',
- 'fail' => 'on_fail',
- 'oops' => 'on_oops',
- },
- ],
- heap => {},
- args => [ $opts ],
- );
-}
-
-sub _start {
+sub on_start {
my ($heap, $session, $kernel, $opt) = @_[ HEAP, SESSION, KERNEL,
ARG0];
my ($address, $socket, $port) = ($opt->{address}, delete $opt->{sock},
$opt->{port});
@@ -78,7 +26,7 @@
my $client = new POE::Wheel::ReadWrite(
Handle => $socket,
Driver => new POE::Driver::SysRW,
- Filter => new POE::Filter::Haver,
+ Filter => new Haver::Core::Filter;
InputEvent => 'input',
FlushedEvent => 'flush',
ErrorEvent => 'error',
@@ -97,7 +45,7 @@
}
-sub _stop {
+sub on_stop {
my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
my ($address, $port) = @$heap{qw(address port)};
@@ -112,7 +60,7 @@
$heap->{plugin}->load('Haver::Server::Commands::Channel');
}
-sub _default {
+sub on_default {
my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
my $cmd = $event;
@@ -207,6 +155,7 @@
eval { $heap->{client}->put(['OOPS', $err, @$data]) };
$kernel->yield('shutdown', 'OOPS');
}
+
sub on_fail {
my ($kernel, $heap, $cmd, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
