home *** CD-ROM | disk | FTP | other *** search
/ ftp.urbanrage.com / 2015-02-07.ftp.urbanrage.com.tar / ftp.urbanrage.com / pub / perl / server.pl < prev    next >
Perl Script  |  2005-08-04  |  7KB  |  254 lines
  1. #!/usr/bin/perl
  2. #
  3. # queries blizzards server status page for wow
  4. # at given intervals and is queriable in irc
  5. #
  6. # Copyright Eric Estabrooks 2005
  7. #
  8.  
  9. use Net::IRC;
  10. use IO::All;
  11. use GDBM_File;
  12.  
  13. use threads;
  14. use threads::shared;
  15.  
  16. my %status : shared;
  17. my %items : shared;
  18.  
  19. tie %status, 'GDBM_File', "./server_status_gdbm", &GDBM_WRCREAT, 0600;
  20. tie %items, 'GDBM_File', "./item_gdbm", &GDBM_WRCREAT, 0600;
  21.  
  22. $my_irc_name = "wowbot";
  23.  
  24. #$thr = threads->new(\&do_irc, "irc.insub.org", 6667, "#wow", "private");
  25. #$thr->detach;
  26.  
  27. &do_irc("localhost", 6667, "#chat", "public");
  28.  
  29. sub do_irc {
  30.     my $server = shift;
  31.     my $port = shift;
  32.     my $channel = shift;
  33.     my $response = shift;
  34.     my $irc;
  35.     my $conn;
  36.  
  37.     $irc = new Net::IRC;
  38.     $conn = $irc->newconn(Nick => 'WoWbot',
  39.                           Server => $server,
  40.                           Port => $port,
  41.                           Ircname => $my_irc_name);
  42.     
  43.     $conn->add_global_handler('376', \&on_connect);
  44.     $conn->add_handler('public', \&on_public);
  45.     $conn->add_handler('msg', \&on_private);
  46.  
  47.     $conn->{'CHANNEL'} = $channel;
  48.     $conn->{'RESPONSE'} = $response;
  49.  
  50.     print "starting $server:$port\n";
  51.     $irc->start;
  52. }
  53.  
  54. sub on_connect {
  55.     my $self = shift;
  56.  
  57.     print "$self: joining channel $self->{'CHANNEL'}\n";
  58.     $self->join($self->{'CHANNEL'});
  59. }
  60.  
  61. sub on_private {
  62.     my $self = shift;
  63.     my $event = shift;
  64.     my $current = $self->{'RESPONSE'};
  65.  
  66.     $self->{'RESPONSE'} = "private";
  67.     $event->{'FROM_PRIVATE'} = 'yes';
  68.     &on_public($self, $event);
  69.     $self->{'RESPONSE'} = $current;
  70. }
  71.  
  72. #sub on_public {
  73. #    my $self = shift;
  74. #    my $event = shift;
  75. #   
  76. #    my $thr = threads->new(\&__public_thread, $self, $event);
  77. #    $thr->detach;
  78. #
  79. #    return;
  80. #}
  81.  
  82. sub on_public {
  83.     my $self = shift;
  84.     my $event = shift;
  85.     my $from = "";
  86.     my $key = "";
  87.     my $msg = "";
  88.  
  89.     my @to = @{$event->{'to'}};
  90.     my @args = @{$event->{'args'}};
  91.  
  92.     ($from = lc($event->{'from'})) =~ s/(.*?)\!.*/$1/;
  93.     if ($from eq $my_irc_name) {
  94.         return;
  95.     }
  96.     if ($self->{'RESPONSE'} eq "private") {
  97.         $to = $from;
  98.     } else {
  99.         $to = $to[0];
  100.     }
  101.     foreach $item (@args) {
  102.         next if (($item !~ /\[.+?\]/) && ($event->{'FROM_PRIVATE'} ne "yes"));
  103.         if (!(eval {($key = $item) =~ s/.*?\[(.+?)\].*/$1/;})) {
  104.             if ($event->{'FROM_PRIVATE'} eq "yes") {
  105.                 $key = $item;
  106.             } else {
  107.                 $self->privmsg($from, "sorry, couldn't process query\n");
  108.                 return;
  109.             }
  110.         }
  111.         $key = lc($key);
  112.         if ($key eq "update") {
  113.             &get_status();
  114.             $self->privmsg($to, "done updating\n");
  115.         } elsif (($key eq "all servers") || ($key eq "all down") || ($key eq "all up")) {
  116.             $n = 1;
  117.             $msg = "";
  118.             foreach $item (sort(keys(%status))) {
  119.                 next if $item eq 'STAMP';
  120.                 if ($status{$item} eq 'up') {
  121.                     next if ($key eq "all down");
  122.                     $msg .= sprintf("%-20s", uc($item));
  123.                 } else {
  124.                     next if ($key eq "all up");
  125.                     $msg .= sprintf("%-20s", $item);
  126.                 }
  127.                 if (($n % 5) == 0) {
  128.                     $self->privmsg($from, $msg);
  129.                     sleep(1);
  130.                     $msg = "";
  131.                 }
  132.                 $n++;
  133.             }
  134.             $self->privmsg($from, $msg);
  135.         } elsif (defined($status{$key})) {
  136.             &get_status();
  137.             $self->privmsg($to, "$key is $status{$key}\n");
  138.         } elsif (defined($items{$key})) {
  139.             @lines = split("\n", $items{$key});
  140.             foreach $line (@lines) {
  141.                 if (length($line) > 240) {
  142.                     send_message($self, $to, $line);
  143.                 } else {
  144.                     $self->privmsg($to, "$line\n");
  145.                 }
  146.                 sleep(1);
  147.             }
  148.         } elsif ($key =~ /^http:\/\/www\.thott?bott?\.com\/?.*?=/) {
  149.             &handle_url($self, $to, $key);
  150.         } else { # try regexing the expression
  151.             my @list;
  152.             foreach $item (sort(keys(%items))) {
  153.                 $test = eval {
  154.                     if ($item =~ /$key/) {
  155.                         push @list, $item;
  156.                     }
  157.                 }
  158.             }
  159.             $size = @list;
  160.             if ($size == 1) {
  161.                 @lines = split("\n", $items{$list[0]});
  162.                 foreach $line (@lines) {
  163.                     $self->privmsg($from, "$line\n");
  164.                 }
  165.             } elsif ($size == 0) {
  166.                 $self->privmsg($from, "nothing found for your query\n");
  167.             } else {
  168.                 $line = join (', ', @list);
  169.                 if (length($line) > 240) {
  170.                     send_message($self, $from, $line); #always send it private when large
  171.                 } else {
  172.                     $self->privmsg($from, "possibly: $line");
  173.                 }
  174.             }
  175.         }
  176.     }
  177. }
  178.  
  179. # attempt to get and parse a thotbott url
  180. sub handle_url {
  181.     my $self = shift;
  182.     my $to = shift;
  183.     my $key = shift;
  184.     my $content;
  185.     my @lines;
  186.     my $line;
  187.     my $value = "";
  188.  
  189.     $content < io($key);
  190.     @lines = split(/\n/, $content);
  191.     foreach $line (@lines) {
  192.         next if ($line !~ /class=ttb/);
  193.         @data = ($line =~ /\>([^\<]+?)(?=\<)/g);
  194.         $key = lc($data[0]);
  195.         foreach $item (@data) {
  196.             next if ($item =~ /^Live/);
  197.             if (($item eq "Use") || ($item eq "Equip")) {
  198.                 $value .= $item." ";
  199.             } else {
  200.                 $value .= $item."\n";
  201.             }
  202.             last if ($item =~ /Source/);
  203.         }
  204.         $items{$key} = $value;
  205.         $self->privmsg($to, "learned about $key\n");
  206.         last;
  207.     }
  208. }
  209.  
  210. # send large message (don't flood) privately
  211. sub send_message {
  212.     my $self = shift;
  213.     my $to = shift;
  214.     my $message = shift;
  215.     
  216.     if (length($message) > 1000) {
  217.         $self->privmsg($to, "generated response too large, please refine query\n");
  218.         return;
  219.     }
  220.     for ($i = 0; $i < length($message); $i += 240) {
  221.         $self->privmsg($to, substr($message, $i, 240));
  222.         sleep(1);
  223.     }
  224. }
  225.  
  226. # fills the server hash with status
  227. sub get_status {
  228.     my $content;
  229.     my $step;
  230.  
  231.     $stamp = time;
  232.     if (($status{'STAMP'}+600) < $stamp) {
  233.         print "scraping server status page\n";
  234.         $content < io('http://www.worldofwarcraft.com/serverstatus/'); 
  235.         
  236.         $step = "status";
  237.         @items = split(/\n/, $content);
  238.         foreach $item (@items) {
  239.             next if ($item !~ /\<td class = \"serverStatus/);
  240.             if ($step eq "status") {
  241.                 next if ($item !~ /arrow/);
  242.                 ($current_status = $item) =~ s/.*\/(.*?)arrow.gif.*/$1/;
  243.                 $step = "server";
  244.             } elsif ($step eq "server") {
  245.                 ($server = $item) =~ s/.*color.*?\>(.*?)\<.*/$1/;
  246.                 $server =~ s/(.*?)\&\#039\;(.*)/$1\'$2/;
  247.                 $step = "status";
  248.                 $status{lc($server)} = $current_status;
  249.             }
  250.         }
  251.         $status{'STAMP'} = $stamp;
  252.     }
  253. }
  254.