fx- has asked for the wisdom of the Perl Monks concerning the following question:

I've edited this script so it takes stats m from the remote ircserver, but it doens't take the stats, could anyone help me out? Thx! 
#!/usr/bin/perl
use Socket;

# pseudo-client parameters
$nick = "mrtg";
$ident = "mrtg";
$realname = "MRTG bot";

# server and port to connect to
$ircserver = "irc.krey.net";
$ircport = "6667";

# Where to store the output data (directory MUST exist)
# The number of users on each server will be in a file named like the 
+server.
# An additionnal file named 'global' will be created, containing the s
+um of
# all servers' users.
# An example configuration file is included.
$datapath = "/var/www/mrtg/";

# Where to put the PID file
$pidfile = "/usr/share/doc/mrtg/examples/ircstats2/ircstats2.pid";

# NOTE: Set those variables to 0 to enable, put a # in front of the 
# lines to disable.
# Count the global number of users in "globalusersmrtg" file (MRTG for
+mat)
$globalusersmrtg=0;
# Count the channels in "channelsmrtg" file (MRTG format)
$channelsmrtg=0;
# Count the global number of ircops in "ircopsmrtg" file (MRTG format)
$ircopsmrtg=0;
# Count the number of servers in "serversmrtg" file (MRTG format)
$serversmrtg=0;
# Count the global number of users in "globalusersplain" file
# (Plain text, to be used with others scripts)
#$globalusersplain=0;
# Count the channels in "channelsplain" file (Plain text, 
# to be used with others scripts)
#$channelsplain=0;
# Count the global number of ircops in "ircopsplain" file
# (Plain text, to be used with others scripts)
#$ircopsplain=0;
# Count the number of servers in "serversmrtg file (MRTG format)
$serversplain=0;
# ircops number offset (not to count services, for example)
#$ircopsoffset=0;
# servers number offset (not to count services, for example)
#$serversoffset=0;

# Servers to poll
$server{"old-services.krey.net"}=0;
$server{"be.hub.krey.net"}=0;
$server{"ipv6.be.krey.net"}=0;
$server{"nl.hub.krey.net"}=0;
$server{"chat2.be.krey.net"}=0;
$server{"services-migration.krey.net"}=0;
$server{"skynet.be.krey.net"}=0;
$server{"k.krey.net"}=0;
$server{"hagehosting.nl.krey.net"}=0;
$server{"vrt.be.krey.net"}=0;
$server{"zeelandnet.nl.krey.net"}=0;

##############################################
### DO NOT MODIFY ANYTHING BELOW THIS LINE ###
##############################################

print "Now daemonizing ...\n";
&daemonize;

if (!(($globalusersmrtg eq "")&&($globalusersplain eq "")&&($channelsm
+rtg eq "")&&($channelsplain eq "")&&($ircopsmrtg eq "")&&($ircopsplai
+n eq "")&&($serversplain eq "")&&($serversmrtg eq ""))) {
    $needlusers=1;
}
($g, $g, $proto) = getprotobyname("tcp");
while (true) {
    ($g, $g, $g, $g, $rawserver) = gethostbyname($ircserver);
    if ($rawserver) {
        $serveraddr = pack("Sna4x8", 2, $ircport, $rawserver);
        socket(SOCKET, AF_INET, SOCK_STREAM, $proto) || die "No socket
+: $!";
        if (connect(SOCKET, $serveraddr)){
            select(SOCKET); $| = 1;
            select(STDOUT); $| = 1; 
            print SOCKET "USER $ident a b :$realname\n";
            print SOCKET "NICK $nick\n";
            while (<SOCKET>){
                @i = split(" ",$_);
                if ($i[1] eq "433") {print SOCKET "NICK ".$nick.time()
+."\n";}
                elsif ($i[1] eq "437") {print SOCKET "NICK ".$nick.tim
+e()."\n";}
                elsif ($i[1] eq "376") {&getinfo;}
                elsif ($i[1] eq "402") {$server{lc($i[3])}=0;}
                elsif ($i[1] eq "265") {
                    $i[0]=~s/\://;
                    $server{lc($i[0])}=$i[6];
                }
                elsif ($i[1] eq "266") {
                    if ($globalusersmrtg ne "") {
                        $globalusersmrtg=$i[6];
                    }
                    if ($globalusersplain ne "") {
                        $globalusersplain=$i[6];
                    }
                }
                elsif ($i[1] eq "254") {
                    if ($channelsmrtg ne "") {
                        $channelsmrtg=$i[3];
                    }
                    if ($channelsplain ne "") {
                        $channelsplain=$i[3];
                    }
                }
                elsif ($i[1] eq "251") {
                    if ($serversmrtg ne "") {
                        $serversmrtg=$i[11]-$serversoffset;
                    }
                    if ($serversplain ne "") {
                        $serversplain=$i[11]-$serversoffset;
                    }
                }
                elsif ($i[1] eq "252") {
                    if ($ircopsmrtg ne "") {
                        $ircopsmrtg=$i[3]-$ircopsoffset;
                    }
                    if ($ircopsplain ne "") {
                        $ircopsplain=$i[3]-$ircopsoffset;
                    }
                }
                elsif ($i[1] eq "212") {
                    return if ($i[2] ne "PRIVMSG");
                                        if ($channelsmrtg ne "") {
                                                $statsmmrtg=$i[3];
                                        }
                                        if ($channelsplain ne "") {
                                                $statsmplain=$i[3];
                                        }
                 }
                elsif ($i[0] eq "PING") {
                    &saveinfo;
                    print SOCKET "PONG $i[1]\n";
                    &getinfo;
                }
            }
        }
        close(SOCKET);
    }
    sleep(120);
}

sub saveinfo {
    foreach $s (keys %server){
        open(OUTPUT,">$datapath/$s");
        print OUTPUT "$server{$s}\n$server{$s}\n$time\n";
        close(OUTPUT); 
    }
    if ($globalusersmrtg ne "") {
        open(OUTPUT, ">$datapath/globalusersmrtg");
        print OUTPUT "$globalusersmrtg\n$globalusersmrtg\n$time\n";
        close(OUTPUT);
    }
    if ($channelsmrtg ne "") {
        open(OUTPUT, ">$datapath/channelsmrtg");
        print OUTPUT "$channelsmrtg\n$channelsmrtg\n$time\n";
        close(OUTPUT);
    }
    if ($serversmrtg ne "") {
        open(OUTPUT, ">$datapath/serversmrtg");
        print OUTPUT "$serversmrtg\n$serversmrtg\n$time\n";
        close(OUTPUT);
    }
    if ($ircopsmrtg ne "") {
        open(OUTPUT, ">$datapath/ircopsmrtg");
        print OUTPUT "$ircopsmrtg\n$ircopsmrtg\n$time\n";
        close(OUTPUT);
        $ircopsmrtg=0; # raw 252 pas disp si pas opers

    }
    if ($globalusersplain ne "") {
        open(OUTPUT,">$datapath/globalusersplain");
        print OUTPUT "$globalusersplain";
        close(OUTPUT);
    }
    if ($channelsplain ne "") {
        open(OUTPUT, ">$datapath/channelsplain");
        print OUTPUT "$channelsplain";
        close(OUTPUT);
    }
    if ($serversplain ne "") {
        open(OUTPUT, ">$datapath/serversplain");
        print OUTPUT "$serversplain";
        close(OUTPUT);
    }
    if ($ircopsplain ne "") {
        open(OUTPUT, ">$datapath/ircopsplain");
        print OUTPUT "$ircopsplain";
        close(OUTPUT);
        $ircopsplain=0; # raw 252 pas disp si pas opers
    }
    if ($statsm ne "") {
        open(OUTPUT, ">$datapath/statsmplain");
        print OUTPUT "$statsm";
        close(OUTPUT);
    }
}

sub getinfo {
    foreach $s (keys %server) {
        print SOCKET "lusers * $s\n";
        print SOCKET "stats m $s\n";
    }
    $time=time();
    if ($needlusers==1) {
        print SOCKET "lusers\n";
        print SOCKET "stats m\n";
    }
}

sub daemonize () {
    chdir "/" or die "Can't chdir to /: $!";
    open STDIN, "/dev/null" or die "Can't read /dev/null: $!";
    open STDOUT, ">/dev/null" or die "Can't write to /dev/null: $!";
    defined (my $pid = fork) or die "Can't fork: $!";
    if ($pid) {
        if ($pidfile) {
            open(PIDFILE,">$pidfile");         
            print PIDFILE "$pid\n";                           
            close(PIDFILE);
        }
        exit;
    }
    setsid or die "Can't start a new session: $!";
    open STDERR, ">&STDOUT" or die "Can't dup stdout: $!";
}

[download]

20050404 Edit by ysth: readmore tags

Replies are listed 'Best First'.
Re: IRC Stats
by graff (Chancellor) on Apr 04, 2005 at 05:09 UTC
    Um, you say you "edited" this script, so I would assume you didn't "write" it (i.e. from scratch). It would probably be polite, at least, to say who wrote it or where it came from, and it would certainly be helpful to know what parts were edited by you (maybe even what they were like before you changed them) -- e.g. did you change something below the comment that says  DO NOT MODIFY ANYTHING BELOW THIS LINE ?

    Have you checked that the directories cited in $datapath and $pidfile actually exist, and that you have write permission in those directories?

    Is there anything else you could tell us about its expected and/or actual behavior? ("it doesn't take the stats" seems kind of vague) -- e.g. are there any error messages or other outputs?

    Have you tried stepping through it with the perl debugger, to see how the control flow is going and what sorts of values are being assigned to variables?

    Sorry, but that's about as much help as I can give, based on what you've posted.

    update: Well, I could offer one more tip, but it involves modifying code below the line that says DO NOT MODIFY ANYTHING BELOW THIS LINE -- in the "saveinfo" sub, none of those "open(OUTPUT...)" lines have error checking, so if the open fails, you won't hear about it, and nothing gets saved. If you change those to: 

      open(OUTPUT, ">name_expression") or die "name_expression: $!";

    [download]
    (where "name_expression" is just a placeholder for whatever string is being used as the file name to be opened), you might get more information about what's going wrong. But maybe not -- hard to say.

    (P.S. Welcome to the Monastery!)

[reply]
[d/l]
[select]

      http://snowdog.interpol.be/ircstats21.pl -> The original.

      http://snowdog.interpol.be/mrtg-irc-stats.pl -> This is pl that i wanted to insert in the original.

      Everything works except the statsm (i added that part).
      I doens't create a file statsmmrtg.
[reply]
        Everything works except the statsm (i added that part).

        Huh? I don't find anything in either of those snowdog downloads that matches "statsm" -- I don't have a clue what you're talking about.

        I doens't create a file statsmmrtg.

        Huh?? I don't find anything in either of those snowdog downloads that matches "statsmmrtg" -- I don't have a clue what you're talking about (again).

        Maybe it's just my own lack of exposure to the domain you're trying to work with here, but I also don't see any evidence that you're actually responding directly to anything I said in my previous reply.

        Okay -- I think I get it. In the OP code above, there's this, at line 128: 

                        $statsmmrtg=$i[3];

        [download]
        Now, can you explain why this variable ($statsmmrtg) is never used anywhere else in the OP script? It seems logical that if you only assign a value to it and then never use it, it won't show up in any file or whatever.

        Then at lines 195-199, you have: 

            if ($statsm ne "") {
        open(OUTPUT, ">$datapath/statsmplain");
        print OUTPUT "$statsm";
        close OUTPUT;
    }

        [download]
        and these are the only mention of this variable ($statsm) -- it never gets anything assigned to it. So what would you expect to appear in a data file, if all you print to it is an undefined (null, empty) value?

        Maybe if you used the same variable name in these two places, you'd get your data into that file (assuming you have write permission).

        Turning on warnings would help -- it'll tell you when you only use a given variable name once, and when you try to print an undefined value. Using strict would help more.

        Oh well. Good luck with that, whatever it is.

[reply]
[d/l]
[select]
Re: IRC Stats
by Zaxo (Archbishop) on Apr 04, 2005 at 11:48 UTC

    I don 't see where you've obtained and imported the setsid function. use POSIX 'setsid';

    After Compline,
    Zaxo

[reply]
[d/l]
Re: IRC Stats
by Anonymous Monk on Apr 04, 2005 at 06:58 UTC
[reply]

Back to Seekers of Perl Wisdom