Dispatch.pm 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109
  1. package ESL::Dispatch;
  2. use Data::Dumper;
  3. require ESL;
  4. require Exporter;
  5. use AutoLoader ();
  6. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
  7. $VERSION = "1.0";
  8. @ISA = qw(Exporter DynaLoader);
  9. sub init($;$) {
  10. my $proto = shift;
  11. my $args = shift;
  12. my $class = ref($proto) || $proto;
  13. my $self = {};
  14. $self->{_debug} = $args->{debug} ||= 0;
  15. $self->{host} = $args->{host} ||= "localhost";
  16. $self->{port} = $args->{port} ||= "8021";
  17. $self->{pass} = $args->{pass} ||= "ClueCon";
  18. $self->{_esl} = new ESL::ESLconnection("$self->{host}", "$self->{port}", "$self->{pass}");
  19. $self->{_callback} = undef;
  20. $self->{_custom_subclass} = undef;
  21. return bless($self, $class);
  22. }
  23. sub set_worker($;$$) {
  24. my $self = shift;
  25. $self->{_worker} = shift;
  26. $self->{_timeout} = shift;
  27. }
  28. sub set_callback($;$$) {
  29. my $self = shift;
  30. my $event = shift;
  31. $self->{_callback}->{$event} = shift;
  32. my $subclass = shift;
  33. if($subclass) {
  34. my @subclasses = split(/,/, $subclass);
  35. $self->{_custom_subclass} = \@subclasses;
  36. }
  37. }
  38. sub render_event($;$) {
  39. my $self = shift;
  40. my $event = shift;
  41. my $h = $event->firstHeader();
  42. while ($h) {
  43. $val = $event->getHeader($h);
  44. if($self->{_debug} > 3) {
  45. print "$h -> $val\n";
  46. }
  47. if ($self->{_decode}) {
  48. $val =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
  49. }
  50. $self->{event_hash}->{lc($h)} = $val;
  51. $h = $event->nextHeader();
  52. }
  53. # Execute callback for this event
  54. eval {
  55. if($self->{_debug}) {
  56. $callback = lc($self->{event_hash}->{'event-name'});
  57. print "DEBUG: executing $callback callback\n";
  58. }
  59. &{$self->{_callback}->{lc($self->{event_hash}->{'event-name'})}}($self, $self->{event_hash});
  60. };
  61. }
  62. sub run($;) {
  63. my $self = shift;
  64. my $event;
  65. for(;;) {
  66. # Only register for events we have callbacks for.
  67. for my $key ( keys %{$self->{_callback}} ) {
  68. if ($key =~ m/custom/i) {
  69. foreach $subclass (@{$self->{_custom_subclass}}) {
  70. $self->{_esl}->events("plain", "$key $subclass");
  71. }
  72. next;
  73. }
  74. $self->{_esl}->events("plain", "$key");
  75. }
  76. while ($self->{_esl}->connected()) {
  77. if($self->{_timeout} > 0) {
  78. $event = $self->{_esl}->recvEventTimed($self->{_timeout});
  79. if(!$event) {
  80. eval {&{$self->{_worker}}($self);};
  81. next;
  82. }
  83. } else {
  84. $event = $self->{_esl}->recvEvent();
  85. }
  86. $self->render_event($event,1);
  87. delete $self->{event_hash};
  88. }
  89. sleep 1;
  90. $self->{_esl} = new ESL::ESLconnection("$self->{host}", "$self->{port}", "$self->{pass}");
  91. }
  92. }
  93. 1;