view release on metacpan or  search on metacpan

TOC.pm  view on Meta::CPAN

sub roast_password {
  my ($password, $key) = @_;
  my @skey;
  my $rpassword = "0x";
  my $i = 0;

  if (!$key) { $key = $ROASTING_KEY; }

  @skey = split('', $key);

  for $c (split('', $password)) {
    $p = unpack("c", $c);
    $k = unpack("c", @skey[$i % length($key)]);
    $rpassword = sprintf("%s%02x", $rpassword, $p ^ $k);
    $i ++;
  }

  return ($rpassword);
}


sub encode_string {
  my ($self, $str) = @_;
  my ($estr, $i);

  if (!$str) { $str = $self; }

  $estr = "\"";
  for $i (split('', $str)) {
    if (
      ($i eq "\\") || ($i eq "\{") || ($i eq "\}") ||
      ($i eq "\(") || ($i eq "\)") || ($i eq "\[") ||
      ($i eq "\]") || ($i eq "\$") || ($i eq "\""))  
      { 
        $estr .= "\\";
      }
      $estr .= $i;
  }
  $estr .= "\"";

  return ($estr);
}


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();