Author: bdonlan
Date: 2004-05-30 17:23:54 -0400 (Sun, 30 May 2004)
New Revision: 200
Added:
trunk/haver-gtk/lib/Haver/Client/Gtk/Page.pm
Modified:
trunk/haver-gtk/TODO
trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Channel.pm
trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Query.pm
trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Rawlog.pm
trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Text.pm
Log:
Consolidate logic for session-backed tabs into Haver/Client/Gtk/Page.pm
Modified: trunk/haver-gtk/TODO
===================================================================
--- trunk/haver-gtk/TODO 2004-05-30 16:59:45 UTC (rev 199)
+++ trunk/haver-gtk/TODO 2004-05-30 21:23:54 UTC (rev 200)
@@ -1,5 +1,6 @@
TODO:
* Find some framework for all these pages with associated sessions
+* Hilight active tabs
* Move cmd_* and haver_* to separate files
* Pages.pm should not care about page names
* Server list
Modified: trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Channel.pm
===================================================================
--- trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Channel.pm 2004-05-30
16:59:45 UTC (rev 199)
+++ trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Channel.pm 2004-05-30
21:23:54 UTC (rev 200)
@@ -30,47 +30,66 @@
our $VERSION = 0.01;
-my %warnings = (
- # Warnings captured by this page. Key is haver server warning, value is
subref to call
- # or undef to simply display
- CID_INVALID => sub {
- my $self = shift;
- $self->print_page("The channel ID '$self->{channel}' is
invalid.");
- $self->{joining} = -1;
+sub _collect_warnings {
+ my ($self, $warnings) = @_;
+ push @$warnings,
+ {
+ eid => 'CID_INVALID',
+ handler => sub {
+ $self->print_page("The channel ID '$self->{channel}' is
invalid.");
+ $self->{joining} = -1;
+ },
+ args => [$self->{channel}],
},
- CID_NOT_FOUND => sub {
- my $self = shift;
- $self->print_page("Channel '$self->{channel}' does not exist.");
- $self->{joining} = 0;
+ {
+ eid => 'CID_NOT_FOUND',
+ handler => sub {
+ $self->print_page("Channel '$self->{channel}' does not
exist.");
+ $self->{joining} = 0;
+ },
+ args => [$self->{channel}],
},
- ALREADY_JOINED => sub {
- my $self = shift;
- $self->print_page("Client bug: Tried to join $self->{channel}
when already there.");
- $self->{joining} = 0;
- $self->{present} = 1;
- $poe_kernel->post('haver', 'users', $self->{channel}); # Just
in case
+ {
+ eid => 'ALREADY_JOINED',
+ handler => sub {
+ $self->print_page("Client bug: Tried to join
$self->{channel} when already there.");
+ $self->{joining} = 0;
+ $self->{present} = 1;
+ $poe_kernel->post('haver', 'users', $self->{channel});
# Just in case
+ },
+ args => [$self->{channel}],
},
- NOT_JOINED_PART => sub {
- my $self = shift;
- $self->print_page("Client bug: Tried to part $self->{channel}
when not there.");
- $self->{present} = 0;
- },
-# ACCESS => undef, # XXX: check command?
-# PERM => undef,
-);
+ {
+ eid => 'NOT_JOINED_PART',
+ handler => sub {
+ $self->print_page("Client bug: Tried to part
$self->{channel} when not there.");
+ $self->{present} = 0;
+ },
+ args => [$self->{channel}],
+ };
+ return $self->SUPER::_collect_warnings($warnings);
+}
-my %warnpos = (
- # The position in the args of a given warning of the CID
- # The protocol should probably use IN for this
- CID_INVALID => 0,
- CID_NOT_FOUND => 0,
- ALREADY_JOINED => 0,
- NOT_JOINED_PART => 0,
- # XXX: Can't do access or PERM with current architecture, at least not
easily
-);
-
### METHODS
+sub _object_events {
+ my ($self, $ehash) = @_;
+ $ehash = {qw{
+ haver_joined _joined
+ haver_parted _parted
+ haver_join _join
+ haver_part _part
+ haver_quit _quit
+ haver_users _users
+ haver_msg _msg
+ haver_disconnected _discon
+ }, # qw{
+ %$ehash,
+ };
+
+ return $self->SUPER::_object_events($ehash);
+}
+
sub new ($$) {
my ($class, $name, $present) = @_;
$present ||= 0; # Make sure it's defined
@@ -91,24 +110,7 @@
$page->{local} = 0;
$page->{present} = $present;
$page->{joining} = 0;
- $page->{session} = POE::Session->create(
- object_states => [
- $page => {qw{
- haver_joined _joined
- haver_parted _parted
- haver_join _join
- haver_part _part
- haver_quit _quit
- haver_users _users
- haver_msg _msg
- haver_disconnected _discon
- haver_warn _warn
- _start _start
- _stop _stop
- destroy _destroy
- }}, # $page => {qw{
- ], # object_states =>
- )->ID;
+
return $page;
}
@@ -174,18 +176,6 @@
}
}
-sub added {
- my ($self, $notebook) = @_;
- $self->{notebook} = $notebook;
-}
-
-sub removed {
- # We've been removed from the tablist, destroy the session
- my $self = shift;
- $poe_kernel->post($self->{session}, 'destroy') if $self->{session};
- delete $self->{notebook};
-}
-
sub join {
my $self = $_[0];
@@ -196,16 +186,6 @@
### SESSION EVENTS
-sub _start {
- my ($self, $kernel) = @_[OBJECT,KERNEL];
- # XXX: smaller registration set?
- $kernel->post('haver', 'register', 'all');
-}
-
-sub _stop {
- delete $_[OBJECT]->{session};
-}
-
sub _joined {
my ($self, $kernel, $chan) = @_[OBJECT,KERNEL,ARG1];
if ($self->{channel} eq $chan) {
@@ -291,23 +271,4 @@
$self->{joining} = $self->{present} = 0;
}
-sub _destroy {
- my ($self, $kernel) = @_[OBJECT,KERNEL];
- $kernel->post('haver', 'unregister', 'all');
-}
-
-sub _warn {
- my ($self, $kernel, $args, $chan) = @_[OBJECT,KERNEL,ARG0,ARG1];
- my ($err, $eshort, $elong, @earg) = @$args;
- my $warnpos = $warnpos{$err};
- return unless defined $warnpos;
- #return unless ($chan eq $self->{channel}) && exists $warnings{$err};
- return unless exists $warnpos{$err} && $earg[$warnpos{$err}] eq
$self->{channel};
- if($warnings{$err}) {
- $warnings{$err}($self, @earg);
- } else {
- $self->print_page("Warning from server ($err): $elong");
- }
-}
-
1;
Modified: trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Query.pm
===================================================================
--- trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Query.pm 2004-05-30 16:59:45 UTC
(rev 199)
+++ trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Query.pm 2004-05-30 21:23:54 UTC
(rev 200)
@@ -30,40 +30,48 @@
our $VERSION = 0.01;
-my %warnings = (
- # Warnings captured by this page. Key is haver server warning, value is
subref to call
- # or undef to simply display
- UID_INVALID => undef,
- UID_NOT_FOUND => undef,
-);
+### METHODS
-my %warnpos = (
- # The position in the args of a given warning of the UID
- # The protocol should probably use IN for this
- UID_INVALID => 0,
- UID_NOT_FOUND => 0,
-);
+sub _object_events {
+ my ($self, $ehash) = @_;
+ $ehash = {
+ qw{
+ haver_pmsg _pmsg
+ haver_quit _quit
+ haver_disconnected _discon
+ }, # qw{
+ %$ehash,
+ };
+ return $self->SUPER::_object_events($ehash);
+}
-### METHODS
+sub _collect_warnings {
+ my ($self, $warnings) = @_;
+ push @$warnings,
+ {
+ eid => 'UID_INVALID',
+ handler => sub {
+ my ($self, %stuff) = @_;
+ $self->print_page($stuff{elong});
+ },
+ args => [$self->{UID}],
+ },
+ {
+ eid => 'UID_NOT_FOUND',
+ handler => sub {
+ my ($self, %stuff) = @_;
+ $self->print_page($stuff{elong});
+ },
+ args => [$self->{UID}],
+ };
+ return $self->SUPER::_collect_warnings($warnings);
+}
sub new ($$) {
my ($class, $uid) = @_;
my $self = Haver::Client::Gtk::Page::Text::new($class, "=$uid");
$self->{UID} = $uid;
$self->{local} = 0;
- $self->{session} = POE::Session->create(
- object_states => [
- $self => {qw{
- haver_pmsg _pmsg
- haver_quit _quit
- haver_disconnected _discon
- haver_warn _warn
- _start _start
- _stop _stop
- destroy _destroy
- }}, # $self => {qw{
- ], # object_methods => [
- )->ID;
return $self;
}
@@ -82,16 +90,6 @@
return 1;
}
-sub added {
- my ($self, $notebook) = @_;
- $self->{notebook} = $notebook;
-}
-
-sub removed {
- my $self = $_[0];
- $poe_kernel->post($self->{session}, 'destroy') if $self->{session};
-}
-
sub process_pmsg {
my ($self, $args) = @_;
my ($type, $who, $text) = @$args;
@@ -120,6 +118,7 @@
sub _pmsg {
my ($self, $kernel, $args) = @_[OBJECT,KERNEL,ARG0];
+ $self->process_pmsg($args);
}
sub _quit {
@@ -134,32 +133,4 @@
$self->print_page("Disconnected.");
}
-sub _start {
- my ($self, $kernel) = @_[OBJECT,KERNEL];
- $kernel->post('haver', 'register', 'all');
-}
-
-sub _stop {
- my $self = $_[OBJECT];
- delete $self->{session};
-}
-
-sub _destroy {
- my ($self, $kernel) = @_[OBJECT,KERNEL];
- $kernel->post('haver', 'unregister', 'all');
-}
-
-sub _warn {
- my ($self, $kernel, $args, $chan) = @_[OBJECT,KERNEL,ARG0,ARG1];
- my ($err, $eshort, $elong, @earg) = @$args;
- my $warnpos = $warnpos{$err};
- return unless defined $warnpos;
- return unless exists $warnpos{$err} && $earg[$warnpos{$err}] eq
$self->{UID};
- if($warnings{$err}) {
- $warnings{$err}($self, @earg);
- } else {
- $self->print_page("Warning from server ($err): $elong");
- }
-}
-
1;
Modified: trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Rawlog.pm
===================================================================
--- trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Rawlog.pm 2004-05-30 16:59:45 UTC
(rev 199)
+++ trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Rawlog.pm 2004-05-30 21:23:54 UTC
(rev 200)
@@ -26,6 +26,18 @@
### METHODS
+sub _object_events {
+ my ($self, $ehash) = @_;
+ $ehash = {
+ qw{
+ haver_raw_in _in
+ haver_raw_out _out
+ }, # qw{
+ %$ehash,
+ };
+ return $self->SUPER::_object_events($ehash);
+}
+
sub new {
my ($class, $title) = @_;
$class = ref $class || $class || __PACKAGE__;
@@ -33,26 +45,9 @@
my $self = Haver::Client::Gtk::Page::Text::new($class, $title);
- $self->{session} = POE::Session->create(
- object_states => [
- $self => {qw{
- haver_raw_in _in
- haver_raw_out _out
- _start _start
- _stop _stop
- destroy _destroy
- }}, # $self => {qw{
- ], # object_states =>
- )->ID;
-
return $self;
}
-sub removed {
- my $self = shift;
- $poe_kernel->post($self->{session}, 'destroy');
-}
-
### STATES
sub _in {
@@ -67,16 +62,4 @@
$self->print_page("C: " . join "\t", @data);
}
-sub _start {
- $_[KERNEL]->post('haver', 'register', 'all');
-}
-
-sub _stop {
- delete $_[OBJECT]->{session};
-}
-
-sub _destroy {
- $_[KERNEL]->post('haver', 'unregister', 'all');
-}
-
1;
Modified: trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Text.pm
===================================================================
--- trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Text.pm 2004-05-30 16:59:45 UTC
(rev 199)
+++ trunk/haver-gtk/lib/Haver/Client/Gtk/Page/Text.pm 2004-05-30 21:23:54 UTC
(rev 200)
@@ -26,6 +26,7 @@
};
use Gtk;
+use base "Haver::Client::Gtk::Page";
our $VERSION = 0.01;
@@ -33,8 +34,10 @@
my ($class, $name) = @_;
$class = ref($class) || $class;
- my $frame = Gtk::Frame->new();
+ my $self = Haver::Client::Gtk::Page::new($class, $name);
+ my $frame = $self->{frame};
+
my $hbox = Gtk::HBox->new(0, 0);
$frame->add($hbox);
@@ -50,21 +53,11 @@
$hbox->show;
- my $hash = {
- frame => $frame,
- hbox => $hbox,
- text => $text,
- scroll => $scroll,
- active => 0,
- label => Gtk::Label->new($name),
- type => "text",
- local => 1,
- name => $name,
- };
+ $self->{hbox} = $hbox;
+ $self->{text} = $text;
+ $self->{scroll} = $scroll;
- bless $hash, $class;
-
- return $hash;
+ return $self;
}
sub print_page ($@) {
@@ -74,9 +67,4 @@
$text->insert(undef, undef, undef, join("", map { "$_\n" } @lines));
}
-sub get_name ($) {
- # XXX: probably belongs in a superclass
- return $_[0]->{name};
-}
-
1;
Added: trunk/haver-gtk/lib/Haver/Client/Gtk/Page.pm
===================================================================
--- trunk/haver-gtk/lib/Haver/Client/Gtk/Page.pm 2004-05-30 16:59:45 UTC
(rev 199)
+++ trunk/haver-gtk/lib/Haver/Client/Gtk/Page.pm 2004-05-30 21:23:54 UTC
(rev 200)
@@ -0,0 +1,184 @@
+# vim: set ft=perl ts=4 sw=4:
+# Haver::Client::Gtk::Page.pm - base class for all haver-gtk pages
+#
+# Copyright (C) 2004 Bryan Donlan, 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::Client::Gtk::Page;
+use warnings;
+use strict;
+
+use POE;
+use Gtk;
+use Carp;
+use Data::Dumper;
+
+our $package = __PACKAGE__;
+
+### OVERRIDABLE METHODS
+
+sub _object_events {
+ my ($self, $ehash) = @_;
+ $ehash = {qw{
+ _start _start
+ _stop _stop
+ destroy _destroy
+ haver_warn _warndie
+ haver_die _warndie
+ }, # qw{
+ %$ehash
+ }; # XXX: should haver_die use a different dispatch method?
+ return $ehash;
+}
+
+sub _collect_warnings {
+ # This function collects a list of functions to call for various
warnings
+ # Pass SUPER::_collect_warnings a listref of:
+ # { eid => warning or die type
+ # handler => handler (subref)
+ # context => expected context (optional)
+ # args => [expected args] (optional)
+ # ]
+ # A seperate list is used for each instance
+ # In the event of a collision all entries will be called in listed order
+ # Handlers are called with a list of key => value pairs:
+ # eid => type sent by the server
+ # type => 'haver_warn' or 'haver_die'
+ # eshort => short desc
+ # elong => long desc
+ # context => context (may be undef)
+ # args => [args]
+ #
+ my ($self, $warnlist) = @_;
+ my %warnings;
+ foreach my $entry (@$warnlist) {
+ print Dumper $entry;
+ my $eid = $entry->{eid};
+ push @{$warnings{$eid}}, $entry;
+ }
+ return \%warnings;
+}
+
+sub new {
+ my ($class, $title) = @_;
+ $class = ref $class || $class;
+
+ croak "$package is an abstract base class!" unless $class && $class ne
$package;
+
+ my $self = {
+ frame => Gtk::Frame->new(),
+ label => Gtk::Label->new($title),
+ active => 0,
+ name => $title,
+ };
+ bless $self, $class;
+ my $oe = $self->_object_events({});
+ print Dumper $oe;
+ $self->{session} = POE::Session->create(
+ object_states => [
+ $self => $self->_object_events({}),
+ ], # object_states => [
+ )->ID;
+
+ return $self;
+}
+
+### METHODS
+
+sub _clear_warn_cache {
+ # Call this when the warnings list generated by _collect_warnings needs
to be regenerated
+ delete $_[0]->{_warncache};
+}
+
+sub get_name {
+ return $_[0]->{name};
+}
+
+sub get_frame {
+ return $_[0]->{frame};
+}
+
+sub get_label {
+ return $_[0]->{label};
+}
+
+sub get_active {
+ return $_[0]->{active};
+}
+
+sub set_active {
+ $_[0]->{active} = $_[1];
+}
+
+sub get_noteboox {
+ return $_[0]->{notebook};
+}
+
+sub added {
+ $_[0]->{notebook} = $_[1];
+}
+
+sub removed {
+ $poe_kernel->post($_[0]->{session}, 'destroy') if defined
$_[0]->{session};
+}
+
+### SESSION EVENTS
+
+sub _start {
+ $_[KERNEL]->post('haver', 'register', 'all');
+}
+
+sub _stop {
+ delete $_[OBJECT]->{session};
+}
+
+sub _destroy {
+ $_[KERNEL]->post('haver', 'unregister', 'all');
+}
+
+sub _warndie {
+ my ($self, $kernel, $state, $args, $context) =
@_[OBJECT,KERNEL,STATE,ARG0,ARG1];
+ my ($eid, $eshort, $elong, @earg) = @$args;
+ my $warning = $state eq 'haver_warn';
+
+ $self->{_warncache} ||= $self->_collect_warnings([]);
+
+ my $wlist = $self->{_warncache}{$eid};
+ return unless $wlist;
+
+ ENTRY:
+ foreach my $entry (@$wlist) {
+ my $i;
+ if (defined($entry->{context}) && (!defined($context) ||
$context ne $entry->{context})) {
+ next;
+ }
+ if (defined($entry->{args})) {
+ for ($i = 0; $i < @{$entry->{args}}; $i++) {
+ if (defined($entry->{args}[$i]) && $earg[$i] ne
$entry->{args}[$i]) {
+ next ENTRY;
+ }
+ }
+ }
+ $entry->{handler}(
+ eid => $eid,
+ type => $state,
+ eshort => $eshort,
+ elong => $elong,
+ context => $context,
+ args => [EMAIL PROTECTED],
+ );
+ }
+}
