view release on metacpan or  search on metacpan

TOC.pm  view on Meta::CPAN

sub register_callback {
  my ($self, $event, $func, @args) = @_;

  push (@{$self->{callback}{$event}}, $func);
  @{$self->{callback}{$func}} = @args;

  return;
}


sub callback {
  my ($self, $event, @args) = @_;
  my $func;

  for $func (@{$self->{callback}{$event}}) {
    eval { &{$func} ($self, @args, @{$self->{callback}{$func}}) };
  }

  return;
}


sub clear_callbacks {
  my ($self) = @_;
  my $k; 
 
  print "................ TOC clear_callbacks\n";
  for $k (keys %{$self->{callback}}) {
    print ".............. Clear key ($k)\n";
    delete $self->{callback}{$k};
  }

  print "...............S TOC scan callbacks\n";
  for $k (keys %{$self->{callback}}) {
    print ".............S Scan key ($k)\n";
  }
}


sub new {
  my ($tochost, $authorizer, $port, $nickname, $password) = @_;
  my ($self, $ipaddr, $sflap);

  $self = { 
      nickname => $nickname, 
      password => $password, 
      caller => "file:line" 
      };
  
  bless($self);

  $sflap = AOL::SFLAP::new($tochost, $authorizer, $port, $nickname);
  $self->{sflap} = $sflap;

  #print "*************************** AOL::TOC::new(...) sflap = $self->{sflap}\n";
  #print "                            sflap cb = $self->{sflap}{callback}\n";

  #$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_SIGNON,    \&sflap_signon, $password, "english", "TIK:\$Revision: 1.148 \$", $self);
  #$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_DATA,      \&sflap_data, $self);
  #$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_ERROR,     \&sflap_error, $self);
  #$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_SIGNOFF,   \&sflap_signoff, $self);
  #$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_KEEPALIVE, \&sflap_keepalive, $self);
  #
  #$self->register_callback("SIGN_ON", \&check_version);
  #$self->register_callback("CHAT_JOIN", \&_chat_join);

  return $self;
}


sub destroy {
  my ($self) = @_;
  
  print "toc destroy\n";
  $self->{sflap}->destroy();

  $self->{callback} = undef;
  $self = undef;

  return;
}


sub set_debug {
  my ($self, $level) = @_;

  $self->{sflap}->set_debug($level);
}


sub debug {
  my ($self, @args) = @_;

  if ($self->{debug_level} > 0) {
    print @args;
  }
}


sub connect {
  my ($self) = @_;

  $self->{sflap}->register_callback($AOL::SFLAP::SFLAP_SIGNON,    \&sflap_signon, $self->{password}, "english", "TIK:\$Revision: 1.148 \$", $self);
  $self->{sflap}->register_callback($AOL::SFLAP::SFLAP_DATA,      \&sflap_data, $self);
  $self->{sflap}->register_callback($AOL::SFLAP::SFLAP_ERROR,     \&sflap_error, $self);
  $self->{sflap}->register_callback($AOL::SFLAP::SFLAP_SIGNOFF,   \&sflap_signoff, $self);
  $self->{sflap}->register_callback($AOL::SFLAP::SFLAP_KEEPALIVE, \&sflap_keepalive, $self);
  
  $self->register_callback("SIGN_ON", \&check_version);
  $self->register_callback("CHAT_JOIN", \&_chat_join);

  $self->{sflap}->connect();
}

sub close {
  my ($self) = @_;
  my $k;

  $self->clear_callbacks();
  $self->{sflap}->close();
}


sub check_version {
  my ($self, $version) = @_;

  if ($version > $TOC_VERSION) {
    $self->destroy();
  }

  $self->init_done();

  return;
}


sub send {
  my ($self, $data) = @_;

  $self->{sflap}->send($AOL::SFLAP::SFLAP_DATA, $data);
}


sub dispatch {
  my ($self) = @_;

  $self->{sflap}->recv();
}


# Utilities

sub signon {
  my ($self, $authorizer, $port, $nickname, $roasted_password, $language, $version) = @_;

  $self->send("toc_signon $authorizer $port $nickname $roasted_password $language " . &encode_string($version));
  return;
}

sub init_done {
  my ($self) = @_;

  $self->send("toc_init_done");
  return;
}

TOC.pm  view on Meta::CPAN

    ($beautified_nick) = ($args =~ /^(.*)$/);
    $toc->callback("NICK", $beautified_nick);
  }

  if ($cmd eq "IM_IN") {
    ($nickname, $autoresponse, $message) = ($args =~ /^(.*)\:(.*)\:(.*)$/);
    $toc->callback("IM_IN", $nickname, $autoresponse, $message);
  }

  if ($cmd eq "UPDATE_BUDDY") {
    ($nickname, $online, $evil, $signon_time, $idle_time, $class) = ($args =~ /^(.*)\:(.*)\:(.*)\:(.*)\:(.*)\:(.*)$/);
    $toc->callback("UPDATE_BUDDY", $nickname, $online, $evil, $signon_time, $idle_Time, $class);
  }

  if ($cmd eq "ERROR") {
    ($code, $args) = ($args =~ /^(\d*).?(.*)$/);
    $toc->callback("ERROR", $code, $args);
  }

  if ($cmd eq "EVILED") {
    ($evil_level, $nickname) = ($args =~ /^(.*)\:(.*)$/);
    $toc->callback("EVILED", $evil_level, $nickname);
  }

  if ($cmd eq "CHAT_JOIN") {
    ($room_id, $room_name) = ($args =~ /^(.*)\:(.*)$/);
    $toc->callback("CHAT_JOIN", $room_id, $room_name);
  }

  if ($cmd eq "CHAT_IN") {
    ($room_id, $nickname, $whisper, $message) = ($args =~ /^(.*)\:(.*)\:(.*)\:(.*)$/);
    $toc->callback("CHAT_IN", $room_id, $nickname, $whisper, $message);
  }

  if ($cmd eq "CHAT_UPDATE_BUDDY") {
    ($room_id, $inside, $nicknames) = ($args =~ /^(.*)\:(.*)\:(.*)$/);
    $toc->callback("CHAT_UPDATE_BUDDY", $room_id, $inside, $nicknames);
  }

  if ($cmd eq "CHAT_INVITE") {
    ($room_name, $room_id, $nickname, $message) = ($args =~ /^(.*)\:(.*)\:(.*)\:(.*)$/);
    $toc->callback("CHAT_INVITE", $room_name, $room_id, $nickname, $message);
  }

  if ($cmd eq "CHAT_LEFT") {
    ($room_id) = ($args =~ /^(.*)$/);
    $toc->callback("CHAT_LEFT", $room_id);
  }

  if ($cmd eq "GOTO_URL") {
    ($window_name, $url) = ($args =~ /^(.*)\:(.*)$/);
    $toc->callback("GOTO_URL", $window_name, $url);
  }

  if ($cmd eq "PAUSE") {
    $toc->callback("PAUSE");
  }

}

sub sflap_error {
  my ($self, $data, $toc) = @_;

  return;
}

sub sflap_signoff {
  my ($self, $data, $toc) = @_;

  $toc->callback("CLOSED");

  #foreach $k (keys %{$toc->{callback}}) {
  #  print "Deleting .. $k\n";
  #  delete $toc->{callback}{$k};
  #}

  $toc->destroy();

  return;
}

sub test {
  my ($self) = @_;

  return \&test($self);
}

sub send_signoff {
  my ($self) = @_;

  $self->{sflap}->send($AOL::SFLAP::SFLAP_SIGNOFF, "");
}

1;
__END__