a_protocols_licq-parser.pl

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

##!/usr/bin/perl
#
# Schpati - Pre-Alpha of AndyChat v3.xx
# MODULE: Protocols - Licq (parses bad things :P)
#
# 31st of May, 2000
# -  (5.50pm) Fix for (vn) stuff.
#
# 28th of April, 2000
# -  (6.08pm) Started work on this
# - (12.55am) As of now...
#             FIFO message sending works
#             Monitors Licq output and can detect user_online, user_offline and status changes(*)
#

sub licq_parser__do_one_loop {
  my ($whichwin) = @_;

  $self = $window[$whichwin]{control};

  *FH = \$window[$whichwin]{handle};

  if (! $window[$whichwin]{handle})
  {
    AddLine($whichwin, "Bad Error: Licq handler loop called with no handle");
  }
  else
  {
      $tmpline = ReadLine -1, FH;
      if ($tmpline && length($tmpline) > 10)
      {
        $tmpline = substr($tmpline, 10, -1);
      }
      else
      {
        $tmpline = "";
      }

      __licq_reparse:

      if (! $tmpline)
      {
      }
      elsif (substr($tmpline, 0, 5) eq "[UDP]")
      {
        $tmpline = substr($tmpline, 6);
        if ($tmpline eq "Online system message.")
        {
          $tmpline = ReadLine -1, FH;
          if ($tmpline && length($tmpline) > 10)
          {
            $tmpline = substr($tmpline, 10, -1);
          }
          else
          {
            $tmpline = "";
          }
          if (substr($tmpline, 0, 5) ne "     ")
          {
            goto __licq_reparse;
          }
        }
        elsif (index($tmpline, "changed status") > 10)
        {
          $tmpuin = substr($tmpline, 0, index($tmpline, "changed status") - 1);
          $tmpuin = substr($tmpuin, rindex($tmpuin, "(") + 1, -1);
          $tmpline = substr($tmpline, index($tmpline, "changed status") + 16, -1);
          $tmpstatus = __icq__TextToStatus($tmpline);

          if ($tmpstatus eq "Unknown")
          {
            AddLine($whichwin, "ERR: Unknown Status $tmpline for $tmpuin");
          }
          else
          {
            icq__on_userstatus($self, $tmpuin, $tmpstatus);
          }
        }
        elsif (substr($tmpline, -19, 13) eq " went offline")
        {
          $tmpuin = substr($tmpline, 0, - 19);
          $tmpuin = substr($tmpuin, rindex($tmpuin, "(") + 1, -1);
          icq__on_useroffline($self, $tmpuin);
        }
        elsif (substr($tmpline, -18, 12) eq " went online")
        {
          $tmpuin = substr($tmpline, 0, - 18);
          $tmpuin = substr($tmpuin, rindex($tmpuin, "(") + 1, -1);
          icq__on_useronline($self, $tmpuin, 0);
        }
        else
        {
        AddLine($whichwin, "`2" . qbTIME() . " `8[`7UDP`8] `7" . DoubleQuote($tmpline));
        }
      }
      elsif (substr($tmpline, 0, 5) eq "[TCP]")
      {
      }
      elsif (substr($tmpline, 0, 5) eq "[???]")
      {
        $tmpline = substr($tmpline, 6);
        AddLine($whichwin, "`2" . qbTIME() . " `8[`7???`8] `5" . DoubleQuote($tmpline) . "`7");
      }
      elsif (substr($tmpline, 0, 5) eq "[WRN]")
      {
        $tmpline = substr($tmpline, 6);
        AddLine($whichwin, "`2" . qbTIME() . " `8[`7WRN`8] `6" . DoubleQuote($tmpline) . "`7");
      }
      elsif (substr($tmpline, 0, 5) eq "[INI]")
      {
        $tmpline = substr($tmpline, 6);
        AddLine($whichwin, "`2" . qbTIME() . " `8[`7INI`8] `3" . DoubleQuote($tmpline) . "`7");
      }
      elsif (substr($tmpline, 0, 5) eq "     ")
      {
        AddLine($whichwin, "ERR: Received $tmpline out of place");
      }
  }
}

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

  if (-r $config{'licq_fifo'})
  {
    open(THEFIFO, ">$config{'licq_fifo'}");
    print THEFIFO "message $to $data\n";
    close(THEFIFO);
  }
  else
  {
    AddLine($thiswin, "ERR: Could not open Licq FIFO");
  }
}