a_protocols_web_clubgabbay.pl

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

#!/usr/bin/perl
#
# Schpati - Pre-Alpha of AndyChat v3.xx
# MODULE: Protocols - Web - Club Gabbay - http://www.clubgabbay.com
#
# 21st of November, 2000
# - (10.23am) Began work on Club Gabbay
# - (10.47am) Implemented web__newGabbay and web__killGabbay
# - (11.54am) Finished researching protocol (urk! referer checking!)
# - (12.16pm) Kinda implemented __connect
# -  (4.15pm) Finally got __connect, __refresh, and __parse working.
# -  (5.14pm) Implemented __speak!
# -  (7.04pm) Fixed midnight problem :)
# -  (7.08pm) Stupid midnight problem :)
# -  (7.23pm) Still sorting out problem :)
# -  (7.46pm) Fixed missing message problem to create duplicate message program and kinda fixed that
#

# Web Gabbay Special Functions

sub web__newGabbay {
  my ($acy) = @_;

  if ($web__gabbaycount)
  {
    return;
  }
  else
  {
    $web__gabbaycount = 1;
  }
  web__killGabbay($web__gabbaycount, 1);
  if ($acy) { $web__gabbay{window} = $acy; }
  return $web__gabbaycount;
}

sub web__killGabbay {
  my ($acz, $acx) = @_;

  $web__gabbay{control} = "";
  $web__gabbay{status} = "";
  $web__gabbay{name} = "";
  $web__gabbay{window} = "";
  $web__gabbay{refresh} = 0;

  while (! $acx && $acz eq $web__gabbaycount && ! $web__gabbay{status} && $web__gabbaycount)
  {
    $web__gabbaycount--;
  }
}

# Web Gabbay Bits!

$__web_mark9 = "`9" . chr(250) . "`%/`9" . chr(250) . " `7";
$__web_mark10 = "`0" . chr(250) . "`%/`0" . chr(250) . " `%";
$__web_mark12 = "`@" . chr(250) . "`%/`@" . chr(250) . " `7";
$__web_mark13 = "`#" . chr(250) . "`%/`#" . chr(250) . " ";
$__web_mark14 = "`\$" . chr(250) . "`%/`\$" . chr(250) . " `7";

# Web Gabbay Listen/Response

sub web__gabbay__connect {
  $whichwin = $web__gabbay{window};

  if (! $window[$whichwin]{protocol})
  {
    AddLine($whichwin, "Club Gabbay can not start within a non-existant window", $__web_mark14);
  }
  elsif ($window[$whichwin]{protocol} ne 1)
  {
    AddLine($whichwin, "This windows already has an attached protocol", $__irc_mark14);
  }
  else
  {
    $window[$whichwin]{protocol} = 32;
    my $url = 'http://www.clubgabbay.com/htmls/lobby.html';
    my $res = $ua->request(GET $url);
    my $tb = HTML::TreeBuilder->new;
    $tb->parse($res->content);
    my @forms = @{$tb->extract_links(qw(FORM))};
    my $f = HTTP::Request::Form->new($forms[0][1], $url);
    $f->field("USER", $web__gabbay{name} || $my[$whichwin]{name} || "AC$Build");
    $f->field("SAYS", "<b>Enters The Lobby using AndyChat - http://andy.secret.com.au/</b>");
    $f->field("HISTORY", "30");
    my $g = $f->press();
    $g->referrer("http://www.clubgabbay.com/htmls/lobby.html");
    $res = $ua->request($g);
    if ($res->is_success)
    {
      $window[$whichwin]{control} = $res;
      $web__gabbay{control} = $res;
      my $tb = HTML::TreeBuilder->new;
      $tb->parse($res->content);
      my @forms = @{$tb->extract_links(qw(FORM))};
      my $url = 'http://www.clubgabbay.com:2000/'; 
      my $f = HTTP::Request::Form->new($forms[0][1], $url);
      $web__gabbay{f} = $f;
      $web__gabbay{status} = 2;
      $window[$whichwin]{sortusers} = 1;
      $window[$whichwin]{channel} = "Club Gabbay";
      $window[$whichwin]{topic} = "http://www.clubgabbay.com/";
      if (! $web__gabbay{name}) { $web__gabbay{name} = $my[$whichwin]{name} || "AndyChat"; }

      if ($whichwin eq $thiswin)
      {
        RedrawChanInfo();
        ReTitle("[$window[$whichwin]{channel}] $window[$whichwin]{topic}");
      }
      else
      {
        RedrawActivity();
      }
      web__gabbay__parse($res->content);
      return $res;
    }
    else
    {
      return;
    }
  }
}

sub web__gabbay__parse {
  my ($data) = @_;
  my ($user, $ii, @data, $timestamp, $offset, $oldtimestamp);

  $web__gabbay{olddata} = $data;

  $whichwin = $web__gabbay{window};

  $web__gabbay{refresh} = time();

#  $data = join '', @data;

  open(BLA, ">bla3.test");
  print BLA "$data";
  close(BLA);

#  AddLine($thiswin, $data[$#data--]);
#  AddLine($thiswin, $data[$#data--]);
#  AddLine($thiswin, $data[$#data--]);
#  AddLine($thiswin, $data[$#data--]);

  @data = split(chr(10), $data);

#  AddLine($whichwin, "Stage 1: Data is now " . $#data);

  for ($ii = 0; $ii < 33; $ii++)
  {
    shift @data;
  }

#  AddLine($whichwin, "0: $data[0]");
#  AddLine($whichwin, "1: $data[1]");
#  AddLine($whichwin, "2: $data[2]");

#  AddLine($whichwin, "Stage 2: Data is now " . $#data);

  NoMoreUsers($whichwin);
  $window[$whichwin]{noupdate} = 1;

  while (! ($data[0] =~ /^\<\//))
  {
    $user = substr($data[0], 15);
    $user = substr($user, 0, index($user, "\""));
    AddUser($whichwin, $user);
    shift @data;
  }
  $window[$whichwin]{noupdate} = 0;
  if ($whichwin eq $thiswin) { RedrawNicks(); }

#  AddLine($whichwin, "0: $data[0]");
#  AddLine($whichwin, "1: $data[1]");
#  AddLine($whichwin, "2: $data[2]");

#  AddLine($whichwin, "Stage 3: Data is now " . $#data);

  for ($ii = 0; $ii < 23 + $window[$whichwin]{users} + 2 + $window[$whichwin]{users} + 6; $ii++)
  {
    shift @data;
  }

#  AddLine($whichwin, "0: $data[0]");
#  AddLine($whichwin, "1: $data[1]");
#  AddLine($whichwin, "2: $data[2]");

#  AddLine($whichwin, "Stage 4: Data is now " . $#data);

  $data[0] = substr($data[0], 28);

  $ii = 0;
  IISIR: while (! ($data[0] =~ /^\<SCRIPT/))
  {
    if (length($data[0]) > 2)
    {
      $data[0] =~ s/<b>/\002/g;
      $data[0] =~ s/<\/b>/\002/g;
      $data[0] =~ s/<([^>]|\n)*>//g;

      $timestamp = int("1" . substr($data[0], 1, 2) . substr($data[0], 4, 2) . substr($data[0], 7, 2));
      $offset = 0;
      $oldtimestamp = "";

      while (substr($chline[$whichwin][0 + $offset], 2, 1) ne "(" && $chline[$whichwin][0 + $offset + 1])
      {
        $offset++;
      }

      if (substr($chline[$whichwin][0 + $offset], 2, 1) eq "(")
      {
        $oldtimestamp = int("1" . substr($chline[$whichwin][0 + $offset], 3, 2) . substr($chline[$whichwin][0 + $offset], 6, 2) . substr($chline[$whichwin][0 + $offset], 9, 2));
      }

#      AddLine($whichwin, $timestamp . "  " . $oldtimestamp);

      if (! $oldtimestamp || ($timestamp >= $oldtimestamp && $timestamp - $oldtimestamp < 20000 && substr(substr($data[0], 0, -1), 13, 50) ne substr($chline[$whichwin][0 + $offset], 17, 50)) || (substr($oldtimestamp, 1, 1) eq "2" && substr($timestamp, 1, 1) eq "0"))
      {
        AddLine($whichwin, substr($data[0], 11, -1), "`2" . substr($data[0], 0, 11) . "`7");
      }
    }
    $ii++;
    if ($ii > 50)
    {
      last IISIR;
    }
    shift @data;
  }

#  AddLine($whichwin, "Stage 5: Data is now " . $#data);
}

sub web__gabbay__refresh {
  my $f = $web__gabbay{f};
  $f->field("USER", $web__gabbay{name});
  $f->field("VERBOSE", "0");
  $f->field("HISTORY", "30");
  $f->field("LOGIN", "");
  $f->field("LEAVE", "");
  $f->field("WHOTO0", "");
  $f->field("SAYS0", "");
  $f->field("ACTION", "says to");
  $f->field("SUBMIT", "RELOAD");
  $f->field("RELOAD", "RELOAD");
  my $g = $f->press();
  $g->referrer("http://www.clubgabbay.com:2000/");
  $res = $ua->request($g);
  if ($res->is_success)
  {
    web__gabbay__parse($res->content);
  }
}

sub web__gabbay__speak {
  my ($msg, $to, $mode) = @_;

  my @action = ("says to", "PRIVATE MSG", "shouts to", "scowls at", "smirks at", "retract", "kotc", "kiss", "hugs", "ROFL",
                "ROFLMAO", "LOL", "grin", "giggle", "wink", "pout", "nudge", "picks up on", "buys drink for", "buys for room",
                "spills drink on");

  my $f = $web__gabbay{f};
  $f->field("USER", $web__gabbay{name});
  $f->field("VERBOSE", "0");
  $f->field("HISTORY", "30");
  $f->field("WHOTO0", $to || "Everyone");
  $f->field("SAYS0", $msg);
  $f->field("ACTION", $action[$mode] || "says to");
  $f->field("LOGIN", "");
  $f->field("LEAVE", "");
  $f->field("SUBMIT", "Send");
#  $f->field("RELOAD", "RELOAD");
  $f->field("SAY1", "Send");
  my $g = $f->press();
  $g->referrer("http://www.clubgabbay.com:2000/");
  $res = $ua->request($g);
  if ($res->is_success)
  {
    web__gabbay__parse($res->content);
  }
}