]> git.somenet.org - somenet/munin.git/blob - cron/ircstats.pl
changed irc services stats plugins
[somenet/munin.git] / 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