package IRC::Multiplex;
sub new {
my $class = shift;
my %parms = @_;
my $self = {%parms};
bless $self,$class;
$self->{mux} = new IO::Multiplex;
return $self;
}
sub add {
my $self = shift;
$self->{write_time} = gettimeofday();
$mux->add($self->{fd});
$mux->set_callback_object($this);
}
sub remove {
my $self = shift;
$mux->remove($self->{fd});
}
sub listen {
my $self = shift;
$mux->listen($fd);
$mux->set_callback_object($this);
}
sub set_timeout {
my $self = shift;
my $time = shift;
$mux->set_timeout($fd, $time);
}
sub write {
my $self = shift;
my $data = shift;
my $now = gettimeofday();
if($self->{write_time} + $self->{send_interval} < $now) {
if(scalar @{$self->{write_buffer}}) {
push @{$self->{write_buffer}}, $data;
$data = shift @{$self->{write_buffer}};
}
$mux->write($self->{fd}, $data);
}
else {
push @{$self->{write_buffer}}, $fd, $data;
}
}
sub input {
my $self = shift;
my $input = shift;
my @lines = ();
push @{$self->{buffer}}, $$input;
$$input = '';
$self->input() if $self->can('input');
}
package IRC;
use base Exporter;
use IRC::Config;
use IO::Multiplex;
use Time::HiRes;
=pod
MOVE the event handling crap here, and make "register_event" look more like Qt's connect:
IRC::register_event($thing, EVENT, $dest, 'method')
$thing->register_event($obj, EVENT, $dest, 'method')
$thing->register_event(EVENT, $dest, 'method')
Need a Timer event class. tied to the mux_timeout maybe
ie:
$event->trigger_in(5) # seconds
$event->wait_for_me(); # waits till this event is triggered, does not block entire app
$obj->register_timer(NOTICE, $dest, &meth, $interval, $times); # $times==undef/0 means inf
------------
[12:04 am] <juvinious> the plugins shouldn't be tied up themselves and should be queried every so often by the host,
if the plugin doesn't respond host resets it
Plugins, API...
---------------
- Process Pool where each plugin runs in a process
- Process Pool where each long running part like a http request happens in
---------------
First Idea:
-----------
Plugins are in the main process,
the Bot provides a IRC::Connection::API for other processes to connect and fiddle with things
the Bot provides a pool of worker processes to
Final Solution (I hope)
-----------------
This one can be handled by a I::C::API module
[12:21 am] <Tomasu> one Idea had the entire thing in a seperate process, so the initialization and registering of events and stuff happens outside of the bots process
[12:21 am] <Tomasu> and the plugin and bot would communicate through some form of IPC
[12:21 am] <Tomasu> but that could lead to a ton of seperate processes
This one can be done
[12:22 am] <Tomasu> then I thought, why not have the initialization in the bot, and then the IRC::Plugin would laucnh its handler in a forked process,
As can this one
[12:22 am] <Tomasu> then I thought, have it all in the bot, and only request to use a seperate process when needed.
[12:22 am] <Tomasu> like for a http request
=cut
=pod
=head1 TODO
=over 1
=item register_event alternatives
=item IRC::erorr
=item conf handling in IRC (done I think)
=item Timer stuff
=back
=cut
our $VERSION = 0.01;
our @EXPORT = qw/&irc_set_logfh &irc_set_conf/;
our $logfh;
our $conf;
my $mux = new IO::Multiplex;
sub new {
my $class = shift;
my %parms = @_;
my $self = {%parms};
bless $self,$class;
$self->{buffer} = [];
$self->{write_buffer} = [];
$self->{write_times} = {};
# $self->{send_interval}
# $self->{fd}
$self->rehash() if $self->can('rehash');
return $self;
}
sub mux {
my $self = shift;
return $mux;
}
sub buffer_get {
my $self = shift;
return shift @{$self->{buffer}};
}
sub buffer_put {
my $self = shift;
unshift @{$self->{buffer}}, @_;
}
sub buffer_add {
my $self = shift;
push @{$self->{buffer}}, @_;
}
# in some rare cases, it may be possible that chunks of orphaned data can be prepended to incomming lines..
sub buffer_getline {
my $self = shift;
my $line = '';
while(scalar @{$self->{buffer}}) {
my $pos = index($self->{buffer}->[0], "\n");
if($pos != -1) {
if($pos && $pos+1 < length $self->{buffer}->[0]) {
$line .= substr $self->{buffer}->[0], 0, $pos+1, '';
}
else {
$line .= shift @{$self->{buffer}};
}
last;
}
else {
$line .= shift @{$self->{buffer}};
}
}
my $pos = index($line, "\n");
if($pos == -1) {
unshift @{$self->{buffer}}, $line;
return;
}
return $line if $line ne '';
}
sub buffer_getlines {
my $self = shift;
my @arr;
while(my $line = $self->buffer_getline()) {
push @arr, $line;
}
return @arr;
}
sub rehash : method {
my $self = shift;
# $self->set_logfh() if !defined $IRC::logfh;
return 1;
}
sub set_conf : method {
my $self = shift;
my $confh = shift;# || new IRC::Config;
if($self eq 'IRC') {
if(!defined $confh) {
$IRC::conf = new IRC::Config;
}
else {
$IRC::conf = $confh;
}
}
else {
if(!defined $confh) {
delete $self->{'confh'}; # back to global config handle
} else {
$self->{'conf'} = $confh;
}
}
}
sub conf : method {
my $self = shift;
return( (exists $self->{conf}) ? $self->{conf} : $IRC::conf );
}
sub cfg_get : method {
my $self = shift;
my $sect = $self->conf->section(shift());
my $key = shift;
# my $default = shift; <--- $_[0]
return( (defined $sect) ? $sect->get($key, $_[0]) : $_[0] );
}
sub cfg_set : method {
my $self = shift;
my $sect = $self->conf->section(shift());
my $key = shift;
my $value = shift;
return $sect->set($key, $value);
}
sub set_logfh : method {
my $self = shift;
my $logfh = shift || \*STDERR;
if($self eq 'IRC') {
$IRC::logfh = $logfh;
}
else {
$self->{'logfh'} = $logfh;
}
}
sub logfh : method {
my $self = shift;
if(exists $self->{'logfh'}) {
return $self->{'logfh'};
}
else {
return $IRC::logfh;
}
}
sub log : method {
my $self = shift;
($package, $filename, $line, $subroutine, $hasargs,
$wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(0);
for my $l (@_) {
print {$self->logfh} $filename . " " . $line . ": " . $l . "\n";
}
}
sub events(;$) : method {
my $self = shift;
my $event = shift;
my @list;
my $id;
if(defined $event) {
if(ref($event) eq 'ARRAY') {
# grab all events of types in the array
for my $e (@$event) {
if($e =~ m|^/(.*)/$|) {
my $eves = $self->events();
for my $evs (@$eves) {
push @list, $evs if $evs->{'code'} =~ /^$1$/;
}
} else {
push @list, @{$self->{'events'}{$e}} if exists $self->{'events'}{$e};
}
}
}
else {
# grab all events of type $event
if($event =~ m|^/(.*)/$|) {
my $eves = $self->events();
for my $evs (@$eves) {
push @list, $evs if $evs->{'code'} =~ /^$1$/;
}
} else {
push @list, @{$self->{'events'}{$event}} if exists $self->{'events'}{$event};
}
}
} else {
# grab all events.
for my $values (values %{$self->{'events'}}) {
push @list, @$values;
}
}
return \@list;
}
=head2 possible implementation for register_event alternatives
make register_event take a array/hash ref as well as a plain EVENT desc
$arr[0] = EVENT
$arr[1] = From
$arr[2] = To
$arr[3] = text =~ /regex/
=cut
sub register_event_cmd : method { # EVENT :$cmd
}
sub register_event_match : method { # EVENT :/$match/
}
sub register_event_from : method { # EVENT :(user/chan)
}
# 1: IRC::register_event($thing, EVENT, $dest, 'method')
# 2: $thing->register_event(EVENT, $dest, 'method')
# 3: $thing->register_event($obj, EVENT, $dest, 'method')
sub register_event : method {
my $self = shift; # methods 1, and 2
if($self->isa('IRC')) {
# if it gets here, the user is plainly daft.
IRC::log("Attempted to call IRC::register_event on a non IRC derived object");
return;
}
# if called as in method 3
if(ref($_[0])) {
if(!$_[0]->isa('IRC')) {
$self->log("Attempted to call \$obj->register_event on a non IRC derived object");
}
else {
$self = shift; # reasign
}
}
# event code/string
my $ecode = shift;
if(!defined $ecode || $ecode eq '') {
$self->log("Attempt to bind to invalid event code/string (aka: undef or '')");
return;
}
# object to send event to
my $obj = shift;
# b0rked user again
if(!ref($obj) || !$obj->isa('IRC')) {
$self->log("Attempt to register event to non IRC derived object.");
return;
}
my $sub = shift;
# bj0rked user or typo...
if(!defined $sub || $sub eq '' || !$self->can($sub)) {
$self->log("Attempt to bind event to non existing sub '$sub' in package " . ref($self));
return;
}
#$self->log("Registering event: '$ecode'");
return if !defined $ecode || !defined $sub || $ecode eq '' || $sub eq '';
my $event = new IRC::Event($self, $ecode, $sub, @_);
# don't check in the IRC::Event:: name space for existacne of event
# that will break on new events being added to IRC, or custom events.
push @{$self->{'events'}{$ecode}}, $event;
return $event;
}
sub unregister_event($&) : method {
my $self = shift;
my $ecode = shift;
my $sub = shift;
return if !defined $ecode || !defined $sub || $ecode eq '' || $sub eq '';
for (my $i=0; $i<@{$self->{'events'}{$ecode}}; ++$i) {
my $eve = $self->{'events'}{$ecode}[$i];
if($eve->subroutine == $sub) {
# remove this event.
splice @{$self->{'events'}{$ecode}}, $i, 1;
}
}
}
sub trigger_event : method {
my $self = shift;
my $event = shift;
#$self->log("trigger_event: '$event' > '" . join(', ', @_) . "'");
my $events = $self->events($event);
for my $eve (@$events) {
$eve->trigger($self, $eve, @_); # double dispatch, sorta, just not really.
}
}
sub error : method {
}
=pod
sub mux_input {
shift->log('virtual mux_input method called');
}
sub mux_close {
shift->log('virtual mux_close method called');
}
sub mux_eof {
shift->log('virtual mux_eof method called');
}
sub mux_outbuffer_empty {
shift->log('virtual mux_outbuffer_empty method called');
}
sub mux_connection {
shift->log('virtual mux_connection method called');
}
sub mux_timeout {
shift->log('virtual mux_timeout method called');
}
=cut
1;
__END__
=pod
=head1 NAME
IRC - API Planning
=head2 MODULES
=over
=item * L<IRC::Event|IRC::Event>
=item * L<IRC::Connection|IRC::Connection>
=back
=head2 CLASS METHODS
=head3 new
=over
Creates a new instance of the IRC class.
=back
=head2 INSTANCE METHODS
=head3 add
=cut
RSS Feed