a_protocols_icq.pl

AndyChat 是一种用Perl 来编写的多协议的控制台聊天程序。它的目的在于提供一种共同的控制台界面

##!/usr/bin/perl
#
# Schpati - Pre-Alpha of AndyChat v3.xx
# MODULE: Protocols - ICQ
#
# 9th of January, 2001
# - (11.22pm) Added icq__sendmsg, and icq__sendurl (sort of)
#
# 15th of June, 2000
# -  (7.25pm) Hacked the doloop procedure to write to the correct window
#
# 13th of June, 2000
# -  (4.51pm) Added icq__newServer, icq__killServer
# -  (6.40pm) Started do_loop
# -  (8.30pm) A lot of parsing in do_loop complete, a lot yet to complete
#
# 28th of April, 2000
# -  (6.09pm) Started work on ICQ function parsers
#

# Variables
$__icq__r1 = "`%(`0RMS`%) `7";

sub icq__newServer {
  my $acz;

  if ($icq__servercount)
  {
    for ($acz = 1; $acz <= $icq__servercount; $acz++)
    {
      if (! $irc__server[$acz]{status})
      {
        return $acz;
      }
    }
    $icq__servercount++;
  }
  else
  {
    $icq__servercount = 1;
  }
  icq__killServer($icq__servercount);
  return $icq__servercount;
}

sub icq__killServer {
  my ($acz) = @_;

  $icq__server[$acz]{control} = "";
  $icq__server[$acz]{status} = "";
  $icq__server[$acz]{lstatus} = "";
  $icq__server[$acz]{subprotocol} = "";
  $icq__server[$acz]{uin} = "";
  $icq__server[$acz]{password} = "";
  $icq__server[$acz]{ip} = "";
  $icq__server[$acz]{port} = "";
  $icq__server[$acz]{window} = "";
  $icq__server[$acz]{users} = 0;
  $icq__server[$acz]{_select} = "";
  $icq__server[$acz]{_overflow} = "";
}

sub icq__doloop {
  my ($aci, $ev, $self, @ready, @lines, $line);

  for ($aci = 1; $aci <= $icq__servercount; $aci++)
  {
    $whichwin = $icq_server[$aci]{window};
    if ($icq__server[$aci]{subprotocol} eq "c")
    {
      licq_parser__do_one_loop($aci);
      return;
    }
    elsif ($icq__server[$aci]{subprotocol} eq "b")
    {
      while (@ready = $icq__server[$aci]{_select}->can_read(0))
      {
        foreach $fh (@ready)
        {
          if (defined recv($fh, $line, 10240, 0) and
                (length($icq__server[$aci]{_overflow}) + length($line)) > 0)  {
            # grab any remnant from the last go and split into lines
            my $chunk = $icq__server[$aci]{_overflow} . $line;
            @lines = split /\012/, $chunk;

            # if the last line was incomplete, pop it off the chunk and
            # stick it back into the frag holder.
            $icq__server[$aci]{_overflow} = (substr($chunk, -1) ne "\012" ? pop @lines : '');
          }
          else
          {
            AddLine($whichwin, "Buffer died for ICQ", Lang(16));
            return;
          }
          foreach $line (@lines) {
            if ($line =~ /^102 /) # CODE_COMMANDxSTART
            {
              AddLine($whichwin, substr($line, 4), $__icq__r1);
            }
            elsif ($line =~ /^200 /) # CODE_HELLO
            {
              if ($icq__server[$aci]{lstatus} eq 3)
              {
                AddLine($whichwin, "Licq RMS Link Established", $__icq__r1);
                if (! send($icq__server[$aci]{control}, "STATUS\015\012", 0)) {
                  AddLine($whichwin, "Error asking for Status", $__icq__r1);
                }
              }
              else
              {
                AddLine($whichwin, "Hmm, 'logged in' packet out of order", $__icq__r1);
              }
            }
            elsif ($line =~ /^201 /) # CODE_USERxINFO
            {
              AddLine($whichwin, substr($line, 4), $__icq__r1);
            }
            elsif ($line =~ /^202 /) # CODE_STATUS
            {
              AddLine($whichwin, "Our status is " . substr($line, 4) . " which translates to " . __icq__TextToStatus(substr($line, 4)), $__icq__r1);
            }
            elsif ($line =~ /^300 /) # CODE_ENTERxUIN
            {
              if ($icq__server[$aci]{lstatus} eq 1)
              {
                AddLine($whichwin, "Sending UIN", $__icq__r1);
                if (! send($icq__server[$aci]{control}, "$icq__server[$aci]{uin}\015\012", 0)) {
                  AddLine($whichwin, "Error sending UIN", $__icq__r1);
                }
                $icq__server[$aci]{lstatus} = 2;
              }
              else
              {
                AddLine($whichwin, "Hmm, UIN request out of order", $__icq__r1);
              }
            }
            elsif ($line =~ /^301 /) # CODE_ENTERxPASSWORD
            {
              if ($icq__server[$aci]{lstatus} eq 2)
              {
                AddLine($whichwin, "Sending Password", $__icq__r1);
                if (! send($icq__server[$aci]{control}, "$icq__server[$aci]{pass}\015\012", 0)) {
                  AddLine($whichwin, "Everything died whilst sending password, let's die now", $__icq__r1);
                }
                $icq__server[$aci]{lstatus} = 3;
              }
              else
              {
                AddLine($whichwin, "Hmm, password request out of order", $__icq__r1);
              }
            }
            else
            {
              AddLine($whichwin, "$line", $__icq__r1);
            }
          }
        }
      }
    }
  }
}

sub __icq__TextToStatus {
  my ($tmpstatus) = @_;

  if ($tmpstatus eq "Online")
  {
    return 0;
  }
  elsif ($tmpstatus eq "Away")
  {
    return 1;
  }
  elsif ($tmpstatus eq "Do Not Disturb")
  {
    return 2;
  }
  elsif ($tmpstatus eq "Not Available")
  {
    return 4;
  }
  elsif ($tmpstatus eq "Occupied")
  {
    return 16;
  }
  elsif ($tmpstatus eq "Free for Chat")
  {
    return 32;
  }
  elsif ($tmpstatus eq "Offline")
  {
    return 65535;
  }
  else
  {
    return "Unknown";
  }
}

sub __icq__StatusToText {
  my ($tmpstatus) = @_;

  if ($tmpstatus eq 0)
  {
    return "`1Online";
  }
  elsif ($tmpstatus eq 1)
  {
    return "`2Away";
  }
  elsif ($tmpstatus eq 2)
  {
    return "`2Do Not Disturb";
  }
  elsif ($tmpstatus eq 4)
  {
    return "`2Not Available";
  }
  elsif ($tmpstatus eq 16)
  {
    return "`2Occupied";
  }
  elsif ($tmpstatus eq 32)
  {
    return "`1Free for Chat";
  }
  elsif ($tmpstatus eq 65535)
  {
    return "`4Offline";
  }
  return "`#Unknown";
}

sub icq__on_useronline {
  my ($self, $tmpuin, $tmpstatus) = @_;

  $whichwin = whichcontrol($self, 3, "Server Messages");
  $tmpnum = FindUser($whichwin, 2, $tmpuin);
  if ($tmpnum)
  {
    if ($usr[$whichwin][$tmpnum]{status} eq 65535)
    {
      AddLine($whichwin, "`2" . qbTIME() . "       `7$usr[$whichwin][$tmpnum]{name} `8(`7$tmpuin`8) `7went `1online`7.");
      $usr[$whichwin][$tmpnum]{status} = $tmpstatus;
      if ($whichwin eq $thiswin) { SortUsers($thiswin); RedrawNicks(); }
    }
    else
    {
      AddLine($whichwin, "`2" . qbTIME() . "       `7$usr[$whichwin][$tmpnum]{name} `8(`7$tmpuin`8) `7went `1online `7twice?");
      $usr[$whichwin][$tmpnum]{status} = $tmpstatus;
      if ($whichwin eq $thiswin) { SortUsers($thiswin); RedrawNicks(); }
    }
  }
  else
  {
    AddLine($whichwin, "`2" . qbTIME() . "       `4Not In List `8(`7$tmpuin`8) `7went `1online`7.");
  }
}

sub icq__on_useroffline {
  my ($self, $tmpuin) = @_;

  $whichwin = whichcontrol($self, 3, "Server Messages");
  $tmpnum = FindUser($whichwin, 2, $tmpuin);
  if ($tmpnum)
  {
    if ($usr[$whichwin][$tmpnum]{status} ne 65535)
    {
      AddLine($whichwin, "`2" . qbTIME() . "       `7$usr[$whichwin][$tmpnum]{name} `8(`7$tmpuin`8) `7went `4offline`7.");
      $usr[$whichwin][$tmpnum]{status} = 65535;
      if ($whichwin eq $thiswin) { SortUsers($thiswin); RedrawNicks(); }
    }
    else
    {
      AddLine($whichwin, "`2" . qbTIME() . "       `7$usr[$whichwin][$tmpnum]{name} `8(`7$tmpuin`8) `7went `4offline `7twice?");
    }
  }
  else
  {
    AddLine($whichwin, "`2" . qbTIME() . "       `4Not In List `8(`7$tmpuin`8) `7went `4offline`7.");
  }
}

sub icq__on_userstatus {
  my ($self, $tmpuin, $tmpstatus) = @_;

  $whichwin = whichcontrol($self, 3, "Server Messages");
  $tmpnum = FindUser($whichwin, 2, $tmpuin);
  if ($tmpnum)
  {
    if ($usr[$whichwin][$tmpnum]{status} ne $tmpstatus)
    {
      AddLine($whichwin, "`2" . qbTIME() . "       `7" . DoubleQuote($usr[$whichwin][$tmpnum]{name}) . " `8(`7$tmpuin`8) `7changed status`8: " . __icq__StatusToText($tmpstatus) . "`7.");
      $usr[$whichwin][$tmpnum]{status} = $tmpstatus;
      if ($whichwin eq $thiswin) { SortUsers($thiswin); RedrawNicks(); }
    }
    else
    {
      AddLine($whichwin, "`2" . qbTIME() . "       `7" . DoubleQuote($usr[$whichwin][$tmpnum]{name}) . " `8(`7$tmpuin`8) `7changed status`8: " . __icq__StatusToText($tmpstatus) . " `7twice?");
    }
  }
  else
  {
    AddLine($whichwin, "`2" . qbTIME() . "       `4Not In List `8(`7$tmpuin`8) `7changed status`8: " . __icq__StatusToText($tmpstatus) . "`7.");
  }
}

sub icq__on_udpmessage {
  my ($self, $tmpdata);

  $whichwin = whichcontrol($self, 3, "Server Messages");

  AddLine($whichwin, "`2" . qbTIME() . " `8[`7UDP`8] `7" . DoubleQuote($tmpdata));
}

sub icq__on_tcpmessage {
  my ($self, $tmpdata);

  $whichwin = whichcontrol($self, 3, "Server Messages");

  AddLine($whichwin, "`2" . qbTIME() . " `8[`7TCP`8] `7" . DoubleQuote($tmpdata));
}

sub icq__sendmsg {
  my ($self, $tmpuin, $tmpmsg);

  $whichwin = whichcontrol($self, 3, $tmpuin);

  if (int($tmpuin) < 10000 || int($tmpuin) > 100000000)
  {
    AddLine($whichwin, "ERR: Invalid UIN specified");
    return;
  }

  if ($window[$whichwin]{subprotocol} eq "c")
  {
    icq__licqfifo__msg($window[$whichwin]{control}, $tmpuin, $tmpmsg);
  }
}

sub icq__sendurl {
  my ($self, $tmpuin, $tmpurl, $tmpmsg);

  $whichwin = whichcontrol($self, 3, $tmpuin);

  if (int($tmpuin) < 10000 || int($tmpuin) > 100000000)
  {
    AddLine($whichwin, "ERR: Invalid UIN specified");
    return;
  }

  if ($window[$whichwin]{subprotocol} eq "c")
  {
  }
}