Jump to content

[Solved] Running Perl scripts won't work.

cl58

By cl58
in Escalated Requests

 Share

Recommended Posts

cl58 Newbie

cl58

Posted
Posted

I am trying to run a log bot for irc on services.cl58tools.co.cc however, I cannot get the script to run. Everytime I run http://services.cl58tools.co.cc/perl/log-irc.pl it says:

 

Internal Server Error

 

The server encountered an internal error or misconfiguration and was unable to complete your request.

 

Please contact the server administrator, webmaster@services.cl58tools.co.cc and inform them of the time the error occurred, and anything you might have done that may have caused the error.

 

More information about this error may be available in the server error log.

 

Additionally, a 404 Not Found error was encountered while trying to use an ErrorDocument to handle the request.

Apache/2.2.11 (Unix) mod_ssl/2.2.11 OpenSSL/0.9.8e-fips-rhel5 mod_wsgi/3.0c3 Python/2.4.3 mod_auth_passthrough/2.1 mod_bwlimited/1.4 FrontPage/5.0.2.2635 Server at services.cl58tools.co.cc Port 80

 

Please Help

Link to comment
Share on other sites
Byron Explorer

Byron

Posted
Posted

Go to your error logs at your cpanel and see if you see error messages.

 

 

You can add this to your script and it will write any errors to a text file named errors.txt

 

BEGIN {
use CGI::Carp qw(carpout);
use diagnostics;
open(LOG, ">errors.txt");
carpout(LOG);
close(LOG);
}

 

Remove it or comment it out when your finished.

 

Link to comment
Share on other sites
cl58 Newbie

cl58

Posted
  • Author
Posted

My entire error log:

[Tue Jan 12 17:28:25 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/500.shtml

[Tue Jan 12 17:23:09 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/500.shtml

[Tue Jan 12 17:23:02 2010] [error] [client 66.249.71.91] File does not exist: /home/cl58tool/public_html/services/500.shtml

[Tue Jan 12 17:23:02 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/403.shtml

[Tue Jan 12 17:23:02 2010] [error] [client 67.85.177.19] attempt to invoke directory as script: /home/cl58tool/public_html/cgi-bin/

[Tue Jan 12 17:22:32 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/500.shtml, referer: http://www.cl58tools.co.cc/mt/

[Tue Jan 12 17:22:31 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/500.shtml, referer: http://www.cl58tools.co.cc/mt/

 

Also, where do I put that code. I am now trying to install MoveableType and I need perl for that.

Link to comment
Share on other sites
Byron Explorer

Byron

Posted
Posted
Also, where do I put that code. I am now trying to install MoveableType and I need perl for that.

 

Put that code right under the she-bang line. This line here:

 

#!/usr/bin/perl

 

Then click onto your file and then refresh your directory to read the errors.txt file.

 

 

 

Link to comment
Share on other sites
cl58 Newbie

cl58

Posted
  • Author
Posted

Which one? The IRC one or a MoveableType file?

 

IRC One

 

#! /usr/bin/perl
BEGIN {
use CGI::Carp qw(carpout);
use diagnostics;
open(LOG, ">errors.txt");
carpout(LOG);
close(LOG);
}
my $BSD_STYLE_LICENSE = <<'EOF';

Copyright (c) 2007, Jason Fesler

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

Neither the name Jason Fesler nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

EOF


use Net::IRCService;
use Net::IRCService::DB;
use YAML::Syck;    # Human readable, used for config
use JSON::Syck;    # Machine compact, for machine readable log
use Text::Wrap;
use strict;
use FileCache maxopen => 100;
use POSIX qw(strftime tzset);

my $VERSION = "0.10";

##########################################################################
# WARNING                                                                #
##########################################################################
# my_* functions will be called BEFORE Net::IRCService::DB functions     #
# will due to our local functions being registered before DB functions.  #
# Unfortunately, DB functions can only be registered AFTER we init       #
# Net::IRCService; and I want to have all hooks in place before then.    #
##########################################################################

my $YAML = "$0.yaml";
my %yaml;           # $0.yaml config
my @bots;           # Array of yaml->bots
my %bots;           # Copy of yaml->bots
my %joined;         # Bots track where they joined
my %topics;         # track topic changes
my %topics_by;      # And who made them
my %my_EK_count;    # How many times any one op killed me

my $db          = new Net::IRCService::DB;
my $statusbar   = '-\|/';
my $statuscount = 0;

$| = 1;

init();
main_loop();

######################################################
# Function declarations                              #
######################################################

# I'm a bit inconsistent on where I use these.
sub print_tty(@);

######################################################
# Configuration and Init  related                    #
######################################################
sub _lc($) {
    my $nick = shift;
    $nick =~ tr/[]\\/{}|/;
    return lc($nick);
}

sub init {
    load_yaml();
    log_init();
    copy_event_numbers();
    &init_service( %{ $yaml{"connection"} } );
} ## end sub init

sub load_yaml {
    my $ref = LoadFile($YAML) or die "$!";
    %yaml = %{$ref};
    after_yaml();
}

sub save_yaml {
    DumpFile( "$YAML.$$", \%yaml );
    if ( -s "$YAML.$$" ) {
        rename( "$YAML.$$", "$YAML" );
    } else {
        warn "Failed to create a useful $YAML.$$";
    }
    after_yaml();
} ## end sub save_yaml

sub after_yaml {
    @bots = keys %{ $yaml{"bots"} };
    %bots = map { $_ => 1 } @bots;
}

my %eventnumbers;

sub copy_event_numbers {
    foreach my $e ( keys %Net::IRCService:: ) {
        if ( $e =~ /^EVENT_/ ) {
            no strict "refs";
            my $f = "Net::IRCService::$e";
            eval {

                # Do not error.  Just try it, and let exceptions go silent.
                my $fvalue = &$f();
                $eventnumbers{$fvalue} = $e;

                # Prepare debugging function
                my $d    = "debug_$e";
                my $perl = "sub $d { my_ALLDEBUG('$e',\@_) }";
                eval $perl;
                die $@ if $@;

                my $m = "my_$e";
                if ( defined( &{$m} ) ) {

                    # Add local function to chain if found
                    add_event_handler( &$f(), \&$m );
                } else {

                    # Add debugging function to chain to show uncaught events
                    add_event_handler( &$f(), \&$d );
                }

            };
        } ## end if ( $e =~ /^EVENT_/ )
    } ## end foreach my $e ( keys %Net::IRCService::)
} ## end sub copy_event_numbers

######################################################
# IRC server events                                  #
######################################################
sub print_tty(@) {
    print @_ if ( -t STDOUT );
}

sub my_ALLDEBUG {
    my $e = shift @_;
    $e = $eventnumbers{$e} if ( exists $eventnumbers{$e} );
    return if ( ( $e eq "EVENT_DEBUG" ) && grep( /irc_send_now/, @_ ) );
    print_tty "\e[1;31m" if ( $e eq "EVENT_RAW_IN" );
    print_tty "\e[1;33m" if ( $e eq "EVENT_RAW_OUT" );
    print_tty "\e[0;33m" if ( $e eq "EVENT_SEND" );
    print_tty "\e[0;33m" if ( $e eq "EVENT_SEND_NOW" );
    local $YAML::Syck::Headless = 1;

    if ( scalar @_ <= 1 ) {
        print "$e\: @_\n";
    } else {
        print Dump( { $e => \@_ } );
    }
    print_tty "\e[0m";
} ## end sub my_ALLDEBUG

sub my_EVENT_DEBUG { } 
sub my_EVENT_RAW_IN { }
sub my_EVENT_RAW_OUT     { }
sub my_EVENT_RAW_SEND    { }
sub my_EVENT_SEND { }
sub my_EVENT_SEND_NOW { }
sub my_EVENT_RAW_SENDNOW { }
sub my_EVENT_CAPAB { }
sub my_EVENT_MODE        { }
sub my_EVENT_SERVER      { }
sub my_EVENT_SNICK       { }
sub my_EVENT_PING { }
sub my_EVENT_INIT { } 

# idle loop
sub my_EVENT_DO_ONE_LOOP {
    $statuscount++;

    if ( -t STDOUT && -t STDERR ) {
        die "what statusbar=$statusbar" unless ( length($statusbar) );
        print STDERR substr( $statusbar, $statuscount % length($statusbar), 1 );
        print STDERR "\r";
    }

    if ( ( $statuscount % 10 ) == 0 ) {
        logbot_periodic();
    }
} ## end sub my_EVENT_DO_ONE_LOOP

sub my_EVENT_DISCONNECTED {
    print "Server has disconnected, we need to clear all state.\n";
    print "Cheating and just exiting instead.\n";
    print "Run this under daemontools.\n";
    exit;
} ## end sub my_EVENT_DISCONNECTED

sub my_EVENT_CONNECTED {
    $db->init();    # Start tracking users, channels, etc.
}

sub my_EVENT_SVINFO {
    bot_connect($_) foreach (@bots);    # Connect our bots
}

sub my_EVENT_SSJOIN {
    my ( $server, $ts, $channel, $mode, $nick ) = @_;
    logbot_do_logging( "JOIN", $nick, $channel, "" );
    bots_join($channel);
}

sub my_EVENT_PART {
    my ( $nick, $channel, $message ) = @_;
    $message ||= "";
    logbot_do_logging( "PART", $nick, $channel, $message );
    $nick       = _lc $nick;
    $channel    = lc $channel;
    $DB::single = 1;

    my (@users) = grep( lc $_ ne $nick, $db->channel_get_users($channel) );
    if ( !scalar @users ) {

        # The bots are the last here. We are no longer needed.
        foreach (@bots) {
            bot_part( $_, $channel );
        }
        delete $topics{$channel};
    } ## end if ( !scalar @users )
} ## end sub my_EVENT_PART

sub my_EVENT_QUIT {
    my ($nick) = @_;
    foreach my $channel ( get_user_channels($nick) ) {
        print
          "EVENT_QUIT: Caling my_EVENT_PART($nick,$channel,Client quit IRC)\n";
        my_EVENT_PART( $nick, $channel, "Client quit IRC" );
    }
} ## end sub my_EVENT_QUIT

sub my_EVENT_CTOPIC {
    my ( $nick, $channel, $topic ) = @_;
    logbot_do_logging( "TOPIC", $nick, $channel, $topic );
    $topics{ lc $channel }    = @_;
    $topics_by{ lc $channel } = $nick;
} ## end sub my_EVENT_CTOPIC

sub my_EVENT_KILL {
    my ( $nick, $bot ) = @_;
    $nick = _lc $nick;
    $bot  = _lc $bot;

    if ( exists $bots{$bot} ) {
        bot_connect($bot);
        bot_say( $bot, $nick,
               "Please do not kill the bot.  It reincarnates and you do not." );
        if ( $my_EK_count{$nick}++ > 2 ) {
            bot_kill(
                  $bot,
                  $nick,
                  "Please do not kill the bot.  It reincarnates and you do not."
            );
        } ## end if ( $my_EK_count{$nick...
        foreach my $channel ( $db->channel_list ) {
            logbot_do_logging( "KILL", $bot, $channel,
                               "Bot killed by $nick but reincarnating" );
            $joined{$bot}{$channel} = 0;
            bots_join($channel);
        } ## end foreach my $channel ( $db->channel_list)
    } ## end if ( exists $bots{$bot...
} ## end sub my_EVENT_KILL

sub my_EVENT_KICK {
    my ( $nick,   $channel, $bot )    = @_;
    my ( $kicker, $channel, $kickee ) = @_;
    $nick = _lc $nick;
    $bot  = _lc $bot;
    if ( exists $bots{$bot} ) {

        # We got kicked, dude!
        logbot_do_logging( "KICK", $bot, $channel,
                           "Kicked by $nick - considering this an uninvite" );
        $joined{$bot}{$channel} = 0;

        # Treat like uninvited:
        $yaml{bots}{$bot}{"channels"}{$channel} = 0;
        save_yaml();

        bot_say( $bot, $nick, "Use /invite $bot $channel to bring me back." );
        bot_say(
            $bot,
            $nick,
            "Or use /msg $bot join $channel   if your client does not do invites"
        );
    } ## end if ( exists $bots{$bot...
    else {
        logbot_do_logging( "KICK", $kicker, $channel, "kicked $kickee" );
        my_EVENT_PART( $kickee, $channel, "kicked by $kicker" );
    }
} ## end sub my_EVENT_KICK

sub my_EVENT_WHOIS {
    my ( $nick, $bot, $crap ) = @_;
    $nick = _lc $nick;
    $bot  = _lc $bot;
    my $s = $yaml{connection}{SERVER_NAME};
    irc_send("311 $nick $bot $s * :services bot uses Net::IRCService");
    irc_send("318 $nick :Nosy bugger aren't you");
} ## end sub my_EVENT_WHOIS

sub my_EVENT_PRIVMSG {
    my ( $nick, $towho, $string ) = @_;
    if ( $towho =~ /^#/ ) {
        logbot_do_logging( "PRIVMSG", $nick, $towho, $string );
    }
    $nick  = _lc $nick;
    $towho = lc $towho;
    if ( exists $bots{$towho} ) {
        if ( $string =~ m#\x01PING# ) {
            $string =~ s#PING#PONG#;
            bot_say( $towho, $nick, $string );
            return;
        }
    } ## end if ( exists $bots{$towho...

    # We still don't know if this is a message to me

    my $tome;
    my $replyto;
    if ( $towho =~ m/^#/ ) {

        # Really a channel
        ( $tome, $string ) = split( /[ :]+/, $string );
        if ( exists $bots{ lc $tome } ) {
            $replyto = $towho;
        } else {
            return;    # Not a message to me.
        }
    } else {
        if ( exists $bots{$towho} ) {
            $tome    = $towho;
            $replyto = $nick;
        } else {
            return;
        }
    } ## end else [ if ( $towho =~ m/^#/ )

    my $bot = $tome;

    # $tome = my name
    # $nick = requestor
    # $replyto = how to reply
    my (@words) = split( /\s+/, $string );

    if ( ( $replyto =~ m/^#/ ) && ( $string =~ /^(part|leave)\s*$/i ) ) {

        # Leave this channel.
        bot_say( $bot, $replyto, "/invite $bot  to bring back" );
        bot_uninvited( $bot, $replyto );
        return;
    } ## end if ( ( $replyto =~ m/^#/...

    if ( $words[0] =~ /^(join|invite)$/ ) {
        if ( $words[1] =~ /^#/ ) {
            if ( $db->channel_exists( $words[1] ) ) {
                bot_invited( $bot, $words[1] );
            } else {
                bot_say( $bot, $replyto, "No such channel $words[1]" );
            }
        } ## end if ( $words[1] =~ /^#/)
        return;
    } ## end if ( $words[0] =~ /^(join|invite)$/)

    my @args = @words;
    my $f;
    $f = "$bot" . "_" . shift @args;
    if ( defined &{$f} ) {
        no strict "refs";
        return if &$f( $nick, $bot, $replyto, @args );
    }
    $f = "$bot" . "_" . "unhandled";
    if ( defined &{$f} ) {
        no strict "refs";
        return if &$f( $nick, $bot, $replyto, @words );
    }

    bot_say( $bot, $replyto, "unknown command \x02$string\x02" );
} ## end sub my_EVENT_PRIVMSG

sub my_EVENT_NOTICE {
    my ( $nick, $towho, $string ) = @_;
    if ( $towho =~ /^#/ ) {
        logbot_do_logging( "NOTICE", $nick, $towho, $string );
    }
} ## end sub my_EVENT_NOTICE

sub my_EVENT_CNICK {
    my ( $oldnick, $newnick, $ts ) = @_;

    # Need to find all channels to log this in.
    foreach
      my $channel ( get_user_channels($oldnick), get_user_channels($newnick) )
    {
        logbot_do_logging( "CNICK", $oldnick, $channel,
                           "nick changed to $newnick" );
    } ## end foreach my $channel ( get_user_channels...
} ## end sub my_EVENT_CNICK

sub my_EVENT_AWAY {
    my ( $nick, $message ) = @_;
    foreach my $channel ( get_user_channels($nick) ) {
        logbot_do_logging( "AWAY", $nick, $channel, "Away message: $message" )
          if ( $message =~ /./ );
        logbot_do_logging( "AWAY", $nick, $channel, "No longer away" )
          if ( $message !~ /./ );
    } ## end foreach my $channel ( get_user_channels...
} ## end sub my_EVENT_AWAY

sub my_EVENT_UNKNOWN {
    my (@stuff) = @_;
    my ($stuff) = @_;
    if ( $stuff =~ m#^PASS (\S+) TS (\d+)# ) {
        irc_send_now("PASS $1 TS $2");
        return;
    }
    if ( $stuff =~ m#^:(\S+) INVITE (\S+) (\#\S+)#i ) {
        my ( $nick, $bot, $channel ) = ( $1, $2, $3 );
        bot_invited( $2, $3 );
        return;
    }
    if ( $stuff =~ m#^:(\S+) AWAY(.*)# ) {
        my ( $nick, $msg ) = ( $1, $2 );
        $msg =~ s/^\s+//;
        $msg =~ s/^://;
        my_EVENT_AWAY( $1, $2 );
        return;
    } ## end if ( $stuff =~ m#^:(\S+) AWAY(.*)#)
    my_ALLDEBUG( "UNKNOWN", @_ );
} ## end sub my_EVENT_UNKNOWN

######################################################
# Helper functions for a bot                         #
######################################################

sub bot_shouldjoin {
    my ( $bot, $channel ) = @_;
    $bot     = _lc $bot;
    $channel = lc $channel;
    if ( exists $yaml{"bots"}{$bot}{"channels"}{$channel} ) {
        return $yaml{"bots"}{$bot}{"channels"}{$channel};
    }
    if ( exists $yaml{"bots"}{$bot}{"autojoin"} ) {
        foreach my $re ( @{ $yaml{"bots"}{$bot}{"autojoin"} } ) {
            return 1 if ( $channel =~ m/$re/ );
        }
    }
    return 0;
} ## end sub bot_shouldjoin

# Scan configs for $channel
# See what bots belong there
# See how many of them are not yet joined.
sub bots_join {
    my ($channel) = @_;
    my @needbots;

    foreach my $bot (@bots) {
        if ( !$joined{$bot}{$channel} ) {
            push( @needbots, $bot ) if ( bot_shouldjoin( $bot, $channel ) );
        }
    }
    return if ( !@needbots );

    my $ts = $db->channel_get_ts($channel);
    $ts ||= time;

    foreach my $bot (@needbots) {
        irc_send("SJOIN $ts $channel + $bot");
        $joined{$bot}{$channel} = 1;
        logbot_do_logging( "JOIN", $bot, $channel );
        if ( $bot eq "logbot" ) {

           # Make sure we record who is already in channel once we start logging
            my @users = $db->channel_get_users($channel);
            if (@users) {
                logbot_do_logging( "JOIN", "@users", $channel );
            }

            # Indicate who we are, and a timestamp
            if ( $yaml{options}{introduction} ) {
                bot_say( $bot, $channel, $yaml{options}{introduction} );
            }
        } ## end if ( $bot eq "logbot" )

        my $f;
        $f = "$bot" . "_" . "joined";
        if ( defined &{$f} ) {
            no strict "refs";
            &{$f}($channel);
        }
    } ## end foreach my $bot (@needbots)
} ## end sub bots_join

sub bot_connect {
    my ($bot) = @_;
    my $t     = time;
    my $s     = $yaml{connection}{SERVER_NAME};
    irc_send("NICK $bot 0 1 +i ~$bot $s $s :services bot");
} ## end sub bot_connect

sub bot_say {
    my ( $bot, $nick, $message ) = @_;
    logbot_do_logging( "PRIVMSG", $bot, $nick, $message );
    irc_send(":$bot PRIVMSG $nick :$message");
}

sub bot_kill {
    my ( $bot, $nick, $message ) = @_;
    my $s = $yaml{connection}{SERVER_NAME};
    irc_send(":$bot KILL $nick $s\!$nick :$message");
}

sub bot_invited {
    my ( $bot, $channel ) = @_;
    $bot                                    = _lc $bot;
    $channel                                = lc $channel;
    $yaml{bots}{$bot}{"channels"}{$channel} = 1;
    bots_join($channel);    # Will join if needed
    save_yaml();
} ## end sub bot_invited

sub bot_part {
    my ( $bot, $channel ) = @_;
    $bot     = _lc $bot;
    $channel = lc $channel;
    if ( $joined{$bot}{$channel} ) {
        logbot_do_logging( "PART", $bot, $channel );
        irc_send(":$bot PART $channel") if ( $joined{$bot}{$channel} );
        $joined{$bot}{$channel} = 0;
    }
} ## end sub bot_part

sub bot_uninvited {
    my ( $bot, $channel ) = @_;
    bot_part(@_);
    $bot                                    = _lc $bot;
    $channel                                = lc $channel;
    $yaml{bots}{$bot}{"channels"}{$channel} = 0;
    save_yaml();
} ## end sub bot_uninvited

sub get_user_channels {
    my ($nick) = @_;
    return () if ( !$db->user_exists($nick) );
    my $ref = $db->user_find($nick);
    my @ret;
    foreach ( keys %{ ${$ref}{channels} } ) {
        push( @ret, $_ );
    }
    @ret = sort @ret;
    return @ret;
} ## end sub get_user_channels

######################################################
# logbot specific                                    #
######################################################

sub logbot_help {
    my ( $nick, $bot, $replyto, @args ) = @_;
    if ( $replyto =~ /^#/ ) {
        bot_say(
            $bot,
            $replyto,
            "To have $bot leave, type: \x02$bot\: leave\x02 . You can get the log url with \x02$bot\: url\x02 . For more info, \x02/msg $bot help\x02."
        );
    } else {
        bot_say(
            $bot,
            $replyto,
            "To invite me to a channel, either \x02/msg $bot invite #channel\x02 or, from the channel, \x02/invite $bot\x02"
        );
        if ( $db->is_oper($nick) ) {
            bot_say(
                $bot,
                $replyto,
                "Oper only: \x02/msg $bot showchannels [-v] [-users] [#channel ..]\x02"
            );
            bot_say(
                $bot,
                $replyto,
                "Oper only: \x02/msg $bot showusers [username ..] [servername ..]\x02"
            );
        } ## end if ( $db->is_oper($nick...
    } ## end else [ if ( $replyto =~ /^#/ )
    return 1;    # Handled
} ## end sub logbot_help

sub logbot_info {
    my ( $nick, $bot, $replyto, @args ) = @_;
    my $i = $yaml{options}{introduction};
    bot_say( $bot, $replyto, "log-irc.pl $VERSION; this installation: $i", );
    return 1;    # Handled
} ## end sub logbot_info

sub logbot_version { return &logbot_info(@_); }

sub logbot_time {
    my ( $nick, $bot, $replyto, @args ) = @_;
    _logbot_ts( "logbot", $replyto );
    return 1;
}

sub _logbot_url {
    my ($channel) = @_;
    my ($name)    = logbot_set_basename($channel);
    my ($dir)     = $yaml{options}{logpath};
    substr( $name, 0, length($dir) ) = "";
    $name =~ s#^/+##;

    my ($urlbase) = $yaml{options}{urlbase};
    $urlbase =~ s#/+$##;
    $name = "$urlbase/$name";
} ## end sub _logbot_url

my %logbot_url_last;

sub logbot_url {
    my ( $nick, $bot, $replyto, @args ) = @_;
    if ( $replyto =~ /^#/ ) {
        my $url = _logbot_url($replyto);
        bot_say( $bot, $replyto, "log file url is \x02 $url \x02" );
        $logbot_url_last{ lc $replyto } = $url;
        return 1;
    } else {
        return 0;
    }
} ## end sub logbot_url

sub logbot_showchannels {
    my ( $nick, $bot, $replyto, @args ) = @_;

    # Privately only.
    return 0 if ( $replyto =~ m/^#/ );
    return 0 unless ( $db->is_oper($nick) );
    my %options = map { lc $_ => 1 } @args;
    $options{"-channel"} = 1 if ( grep( /^#/, @args ) );  # Limit to a few chans

    foreach my $channel ( $db->channel_list ) {

        # Sometimes we only want a specific channel
        next
          if (    ( $options{"-channel"} )
               && ( !exists $options{ lc $channel } ) );
        my @show;
        my @users = $db->channel_get_users($channel);
        my $count = scalar @users;

        # Sometimes we want to know who is inside, too.
        if ( $options{"-users"} ) {
            my @users = $db->channel_get_users($channel);
            foreach my $user (@users) {
                my $ref = $db->user_find($user);
                if ( $db->has_op( $user, $channel ) ) {
                    $user = '@' . ${$ref}{"nick"};
                } elsif ( $db->has_voice( $user, $channel ) ) {
                    $user = '+' . ${$ref}{"nick"};
                }
                push( @show, $user );
            } ## end foreach my $user (@users)
        } ## end if ( $options{"-users"...
        @show = sort @show;
        unshift( @show, "($count)" );

        local ($Text::Wrap::columns) = 400;
        if ( $options{"-v"} ) {
            $channel =~ s/^#//;
            $channel = "#\Q$channel";
        }
        @show = wrap( "$channel ", "$channel ... ", @show );
        foreach (@show) {
            chomp;
            bot_say( $bot, $nick, $_ );
        }
    } ## end foreach my $channel ( $db->channel_list)
    bot_say( $bot, $nick, "End of showchannels @args" );
    return 1;
} ## end sub logbot_showchannels

sub logbot_showusers {

    # Sneak a peek into Net::IRCService::DB - no API
    my ( $nick, $bot, $replyto, @args ) = @_;

    # Privately only.
    return 0 if ( $replyto =~ m/^#/ );
    return 0 unless ( $db->is_oper($nick) );
    my %options = map { lc $_ => 1 } @args;
    $options{"-user"} = 1
      if ( grep( /^[^-]/, @args ) );    # Limit to a few users or a server

    # Copy the hash over.
    my @users = $db->user_list;
    my %byserver;
    foreach my $user (@users) {

        my $ref    = $db->user_find($user);
        my $show   = ${$ref}{'nick'};         # As they are known as, not LC
        my $server = ${$ref}{'server'};       # Where are are in from
        next
          if (    ( $options{"-user"} )
               && ( !exists $options{ lc $user } )
               && ( !exists $options{ lc $server } ) );

        # nick hops ts mode ident host server geco

        $show = "\@$show" if ( $db->is_oper($user) );
        $byserver{$server} ||= [];
        push( @{ $byserver{$server} }, $show );
    } ## end foreach my $user (@users)

    foreach my $server ( sort keys %byserver ) {
        my @show = @{ $byserver{$server} };
        @show = sort @show;
        my $count = scalar @show;
        unshift( @show, "($count)" );
        local ($Text::Wrap::columns) = 400;
        @show = wrap( "$server ", "$server ... ", @show );
        foreach (@show) {
            chomp;
            bot_say( $bot, $nick, $_ );
        }

    } ## end foreach my $server ( sort keys...
    bot_say( $bot, $nick, "End of showusers @args" );
    return 1;
} ## end sub logbot_showusers

######################################################
# Logging related functions go here.                 #
######################################################

my @tz = ();

sub log_init {
    unless (@tz) {
        my $t;
        if ( exists $yaml{options}{tz} ) {
            $t = $yaml{options}{tz};
            if ( !ref $t ) {
                $t = [$t];
            }
            @tz = @{$t};
        } ## end if ( exists $yaml{options...
    } ## end unless (@tz)

    #    die "No TZ in config file (options->tz should be scalar or array)"
    #      unless (@tz);
    $ENV{"TZ"} = $tz[0] if (@tz);
    tzset();

    die "missing options->logpath"  unless ( $yaml{options}{logpath} );
    die "missing options->urlbase"  unless ( $yaml{options}{urlbase} );
    die "missing options->periodic" unless ( $yaml{options}{periodic} );

    logbot_periodic();
} ## end sub log_init

sub channel_safe {
    my ($channel) = @_;
    $channel = lc $channel;
    $channel =~ s/^#//;
    $channel =~ s/[^a-z0-9_-]/_/g;
    return $channel;
} ## end sub channel_safe

my ( $year, $month, $day, $hour, $minute );
my ($nextperiodic);

my %filename_cache;
my %did_ts_cache;

sub logbot_periodic {
    my $time      = time;
    my $frequency = $yaml{options}{periodic};
    if ( $time > $nextperiodic ) {
#        print "logbot_periodic recalculating\n";
        $nextperiodic = $time + $frequency - ( $time % $frequency );
        $ENV{"TZ"} = $tz[0] if (@tz);
        tzset();
        ( $year, $month, $day, $hour, $minute ) =
          split( / /, strftime( '%Y %m %d %H %M', localtime time ) );

        %filename_cache = ();    # Force recalculation
        %did_ts_cache   = ();    # And channel announcements

    } ## end if ( $time > $nextperiodic)
} ## end sub logbot_periodic

sub _logbot_ts {
    my ( $bot, $channel ) = @_;
    $channel = lc $channel;
    my $ts = timestamps();
    $did_ts_cache{$channel} = time;
    bot_say( $bot, $channel, "time is $ts" );
    if ( $channel =~ m/^#/ ) {
        my $url = _logbot_url($channel);
        if ( $url ne $logbot_url_last{$channel} ) {
            bot_say( $bot, $channel, "log file url is now \x02 $url \x02" );
            $logbot_url_last{ lc $channel } = $url;
        }
    } ## end if ( $channel =~ m/^#/)
} ## end sub _logbot_ts

sub logbot_set_basename {
    my ($channel) = lc shift @_;
    if ( !exists $filename_cache{$channel} ) {
        my $channel_safe = channel_safe($channel);
        my $dir          = $yaml{options}{logpath};
        $dir =~ s#/$##;    # Trim to known state
        my $log = "$dir/$channel_safe/$year/$month";
        system( "mkdir", "-p", $log );
        $log .= "/$year-$month-$day";
        $filename_cache{$channel} = $log;
    } ## end if ( !exists $filename_cache...
    return $filename_cache{$channel};
} ## end sub logbot_set_basename

sub openfile_txt {
    my ($channel) = lc shift @_;
    return cacheout ">>", logbot_set_basename($channel) . ".txt";
}

sub openfile_machine {
    my ($channel) = lc shift @_;
    return cacheout ">>", logbot_set_basename($channel) . ".machine";
}

sub logbot_do_logging {
    my ( $event, $nick, $channel, $message ) = @_;
    $nick = _lc $nick;
    my $onick = $nick;
    if ( $nick =~ /^[@\+]/ ) {
        $nick =~ s/^[@\+]//;
    } else {
        if ( $db->is_member( $nick, $channel ) ) {
            $onick = ( $db->has_op( $nick, $channel ) ? '@' : '' ) . $nick;
        }
    }

    $channel = lc $channel;

    no strict "refs";

    if ( $joined{"logbot"}{ lc $channel } ) {
        my $fresh  = !exists $filename_cache{$channel};
        my $fh_mac = openfile_machine($channel);
        my $fh_txt = openfile_txt($channel);
        if ($fresh) {
            $fh_mac->autoflush(1);
            $fh_txt->autoflush(1);
        }

        # Machine parsable
        print $fh_mac JSON::Syck::Dump(
                                        {
                                          "time"    => time,
                                          "event"   => $event,
                                          "nick"    => $onick,
                                          "channel" => $channel,
                                          "message" => $message
                                        }
                                      ) . "\n";

        # Human readable
        my $time = strftime( '%H:%M:%S', localtime time );
        if ( $event eq "PRIVMSG" ) {
            print $fh_txt "$time $channel <$nick> $message\n";

            # Timestamps
            _logbot_ts( "logbot", $channel )
              unless ( $did_ts_cache{$channel}++ );
        } elsif ( $event =~ m#^(CNICK|KILL|AWAY)$# ) {

            # don't show channel name
            print $fh_txt "$time $nick $event $message\n";
        } elsif ( $event eq "TOPIC" ) {
            print $fh_txt "$time $channel $nick changed topic to $message\n";
        } else {
            print $fh_txt "$time $channel $nick $event\n";
        }

    } ## end if ( $joined{"logbot"}...
} ## end sub logbot_do_logging

sub timestamps {
    my $time = time;
    my @res;
    my $prevdate = "";
    if ( !@tz ) {
        my ( $d, $t, $z ) =
          split( / /, strftime( '%Y-%m-%d %H:%M %Z', localtime $time ) );
        return "$d $t $z";
    }
    foreach my $tz (@tz) {
        $ENV{"TZ"} = $tz;
        my ($where) = reverse split( m#/#, $tz );
        tzset();
        my ( $d, $t, $z ) =
          split( / /, strftime( '%Y-%m-%d %H:%M %Z', localtime $time ) );
        if ( $d eq $prevdate ) {
            push( @res, "$where=$t $z" );
        } else {
            push( @res, "$where=$d $t $z" );
            $prevdate = $d;
        }
    } ## end foreach my $tz (@tz)
    $ENV{"TZ"} = $tz[0];
    tzset();
    return join( "; ", @res );
} ## end sub timestamps

 

Also, http://services.cl58tools.co.cc/perl/errors.txt is working now.

Link to comment
Share on other sites
cl58 Newbie

cl58

Posted
  • Author
Posted
Which one? The IRC one or a MoveableType file?

 

Which ever file your having a problem with. I want to download the script to my site and see if I can generate the errors.

 

I put the IRC script up and, if you want to check out MT, I haven't edited anything so you can see http://www.movabletype.com/ for the code (only if you want to check both and fixing one may fix the other).

Link to comment
Share on other sites
Byron Explorer

Byron

Posted
Posted
Why not specify the full path to the file you need to include? Alternately, you can add it to @INC. (I'm basically rehashing the error message - just do what it says.)

 

I thought the errors were telling him that the module [ Net/IRCService.pm ] couldn't be found and that it would need to be added, is that not what it means?

 

 

 

 

Link to comment
Share on other sites
Guest
This topic is now closed to further replies.
 Share
Go to topic listing
×
×
  • Create New...