123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109 |
- package ESL::Dispatch;
- use Data::Dumper;
- require ESL;
- require Exporter;
- use AutoLoader ();
- use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
- $VERSION = "1.0";
- @ISA = qw(Exporter DynaLoader);
- sub init($;$) {
- my $proto = shift;
- my $args = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- $self->{_debug} = $args->{debug} ||= 0;
- $self->{host} = $args->{host} ||= "localhost";
- $self->{port} = $args->{port} ||= "8021";
- $self->{pass} = $args->{pass} ||= "ClueCon";
- $self->{_esl} = new ESL::ESLconnection("$self->{host}", "$self->{port}", "$self->{pass}");
- $self->{_callback} = undef;
- $self->{_custom_subclass} = undef;
- return bless($self, $class);
- }
- sub set_worker($;$$) {
- my $self = shift;
- $self->{_worker} = shift;
- $self->{_timeout} = shift;
- }
- sub set_callback($;$$) {
- my $self = shift;
- my $event = shift;
- $self->{_callback}->{$event} = shift;
- my $subclass = shift;
- if($subclass) {
- my @subclasses = split(/,/, $subclass);
- $self->{_custom_subclass} = \@subclasses;
- }
- }
- sub render_event($;$) {
- my $self = shift;
- my $event = shift;
- my $h = $event->firstHeader();
- while ($h) {
- $val = $event->getHeader($h);
- if($self->{_debug} > 3) {
- print "$h -> $val\n";
- }
- if ($self->{_decode}) {
- $val =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
- }
- $self->{event_hash}->{lc($h)} = $val;
- $h = $event->nextHeader();
- }
- # Execute callback for this event
- eval {
- if($self->{_debug}) {
- $callback = lc($self->{event_hash}->{'event-name'});
- print "DEBUG: executing $callback callback\n";
- }
- &{$self->{_callback}->{lc($self->{event_hash}->{'event-name'})}}($self, $self->{event_hash});
- };
- }
- sub run($;) {
- my $self = shift;
- my $event;
- for(;;) {
- # Only register for events we have callbacks for.
- for my $key ( keys %{$self->{_callback}} ) {
- if ($key =~ m/custom/i) {
- foreach $subclass (@{$self->{_custom_subclass}}) {
- $self->{_esl}->events("plain", "$key $subclass");
- }
- next;
- }
- $self->{_esl}->events("plain", "$key");
- }
- while ($self->{_esl}->connected()) {
- if($self->{_timeout} > 0) {
- $event = $self->{_esl}->recvEventTimed($self->{_timeout});
- if(!$event) {
- eval {&{$self->{_worker}}($self);};
- next;
- }
- } else {
- $event = $self->{_esl}->recvEvent();
- }
- $self->render_event($event,1);
- delete $self->{event_hash};
- }
- sleep 1;
- $self->{_esl} = new ESL::ESLconnection("$self->{host}", "$self->{port}", "$self->{pass}");
- }
- }
- 1;
|