cron/ircstats.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright 2011 by Jan Vales <jan@jvales.net> (Someone <someone@somenet.org>)
   4 #
   5 #    This program is free software: you can redistribute it and/or modify
   6 #    it under the terms of the GNU General Public License as published by
   7 #    the Free Software Foundation, version 3 of the License.
   8 #
   9 #    This program is distributed in the hope that it will be useful,
  10 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #    GNU General Public License for more details.
  13 #
  14 #    You should have received a copy of the GNU General Public License
  15 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16 #
  17
  18 # consider using pybots IRCStats module instead!
  19
  20 require Net::IRC;
  21
  22 mkdir("/tmp/irc", 0775);
  23 open (STATS, '>/tmp/irc/stats.txt');
  24 open (CHANS, '>/tmp/irc/channels.txt');
  25 my $irc = new Net::IRC;
  26 my $conn = $irc->newconn(Nick => 'srv254-stats', Server => 'localhost');
  27 $conn->debug(0);
  28 $conn->add_global_handler('luserclient', \&luserclient);
  29 $conn->add_global_handler('luserchannels', \&luserchannels);
  30 $conn->add_global_handler('endofmotd', \&ask);
  31 $conn->add_global_handler('list', \&list);
  32 $conn->add_global_handler('listend', \&quit);
  33
  34
  35 sub luserclient {
  36     my($self, $event) = @_;
  37     if(($event->args)[1] =~  /There are (\d+) users and (\d+) invisible on (\d+) servers/) {
  38 #        printf STATS "".(($event->args)[1])."\n";
  39         printf STATS "clients.value ".($1 + $2 -1)."\n";
  40         printf STATS "servers.value $3\n";
  41     }
  42 }
  43
  44 sub luserchannels {
  45     my($self, $event) = @_;
  46     if(($event->args)[1] =~  /^(\d+)/) {
  47         printf STATS "channels.value $1\n";
  48     }
  49 }
  50
  51 sub ask {
  52     my($self, $event) = @_;
  53     $conn->list();
  54 }
  55
  56 sub list {
  57     my($self, $event) = @_;
  58     printf CHANS (($event->args)[1])." ".(($event->args)[2])." ".(($event->args)[3])."\n";
  59 }
  60
  61 sub quit {
  62     my($self, $event) = @_;
  63     $self->quit();
  64     close (STATS);
  65     close (CHANS);
  66     exit 0;
  67 }
  68
  69
  70
  71 while(1) {
  72     $irc->do_one_loop();
  73 }
  74