From 92c9a647932e49d9e366b4df3e71e4ab4ee83d12 Mon Sep 17 00:00:00 2001 From: Elijah Perrault Date: Sun, 20 Feb 2011 20:47:09 -0700 Subject: [PATCH] Revert "Getting rid of tabs." This reverts commit cc1c8fd5bcbbecc8a36cb0e0f9b6fc62aca1aebb. Failed. --- auto | 54 ++--- bin/auto | 302 ++++++++++++------------- install | 58 ++--- lib/API/IRC.pm | 176 +++++++-------- lib/API/Log.pm | 110 ++++----- lib/API/Std.pm | 526 +++++++++++++++++++++---------------------- lib/Core/IRC.pm | 42 ++-- lib/Parser/Config.pm | 304 ++++++++++++------------- lib/Parser/IRC.pm | 500 ++++++++++++++++++++-------------------- lib/Parser/Lang.pm | 100 ++++---- modules/Badwords.pm | 16 +- modules/Bitly.pm | 54 ++--- modules/Calc.pm | 72 +++--- modules/EightBall.pm | 16 +- modules/FML.pm | 24 +- modules/HelloChan.pm | 24 +- modules/IsItUp.pm | 70 +++--- modules/SASLAuth.pm | 18 +- modules/Weather.pm | 88 ++++---- rmtabs | 2 - 20 files changed, 1277 insertions(+), 1279 deletions(-) delete mode 100755 rmtabs diff --git a/auto b/auto index a895586..1f256ce 100755 --- a/auto +++ b/auto @@ -8,46 +8,46 @@ PID=bin/auto.pid MODS="Class::Unload DBI" if [ "$1" = "start" ] ; then -ssssif [ -e $PID ]; then -ssss if [ "$2" = "force" ]; then -ssss echo "Starting Auto. . ." -ssss bin/auto -ssss sleep 2 -ssss if [ ! -r $PID ]; then -ssss echo "Possible failed startup... check Auto logs for more information." -ssss fi + if [ -e $PID ]; then + if [ "$2" = "force" ]; then + echo "Starting Auto. . ." + bin/auto + sleep 2 + if [ ! -r $PID ]; then + echo "Possible failed startup... check Auto logs for more information." + fi else echo "Auto appears to be running already. Run ./auto start force to start anyway." fi -sssselse -ssss echo "Starting Auto. . ." -ssss bin/auto -ssss sleep 2 -ssss if [ ! -r $PID ]; then -ssss echo "Possible failed startup... check Auto logs for more information" -ssss fi -ssssfi + else + echo "Starting Auto. . ." + bin/auto + sleep 2 + if [ ! -r $PID ]; then + echo "Possible failed startup... check Auto logs for more information" + fi + fi elif [ "$1" = "stop" ]; then -ssssecho "Stopping Auto. . ." -sssskill -TERM `cat $PID` + echo "Stopping Auto. . ." + kill -TERM `cat $PID` elif [ "$1" = "rehash" ]; then -ssssecho "Rehashing Auto. . ." -sssskill -HUP `cat $PID` + echo "Rehashing Auto. . ." + kill -HUP `cat $PID` elif [ "$1" = "status" ]; then -ssssif [ -e $PID ]; then -ssss echo "Status: Auto appears to be running." -sssselse -ssss echo "Status: Auto appears to not be running." -ssssfi + if [ -e $PID ]; then + echo "Status: Auto appears to be running." + else + echo "Status: Auto appears to not be running." + fi elif [ "$1" = "getmodules" ]; then -sssscpan -i $MODS + cpan -i $MODS else -ssssecho "Usage: auto (start|stop|rehash|status|getmodules)" + echo "Usage: auto (start|stop|rehash|status|getmodules)" fi # vim: set ai sw=4 ts=4: diff --git a/bin/auto b/bin/auto index d196851..5a9335e 100755 --- a/bin/auto +++ b/bin/auto @@ -23,11 +23,11 @@ BEGIN { # Set version information. use constant { ## no critic qw(ValuesAndExpressions::ProhibitConstantPragma) -ssss NAME => 'Auto IRC Bot', -ssss VER => 3, -ssss SVER => 0, -ssss REV => 0, -ssss RSTAGE => 'd', + NAME => 'Auto IRC Bot', + VER => 3, + SVER => 0, + REV => 0, + RSTAGE => 'd', GR => substr `cat $Bin/../.git/refs/heads/indev`, 0, 7 }; } @@ -46,7 +46,7 @@ local $PROGRAM_NAME = 'auto'; # Check for build files. if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") { -sssssay 'Missing build file(s). Please build Auto before running it.' and exit; + say 'Missing build file(s). Please build Auto before running it.' and exit; } # Check build OS. @@ -54,7 +54,7 @@ open my $BFOS, '<', "$Bin/../build/os" or say 'Cannot start: Broken build.' and my @BFOS = <$BFOS>; close $BFOS or say 'Cannot start: Broken build.' and exit; if ($BFOS[0] ne $OSNAME."\n") { -sssssay 'Cannot start: Broken build.' and exit; + say 'Cannot start: Broken build.' and exit; } undef @BFOS; @@ -71,7 +71,7 @@ open my $BFPERL, '<', "$Bin/../build/perl" or say 'Cannot start: Broken build.' my @BFPERL = <$BFPERL>; close $BFPERL or say 'Cannot start: Broken build.' and exit; if ($BFPERL[0] ne $]."\n") { -sssssay 'Cannot start: Broken build.' and exit; + say 'Cannot start: Broken build.' and exit; } undef @BFPERL; @@ -80,7 +80,7 @@ open my $BFVER, '<', "$Bin/../build/ver" or say 'Cannot start: Broken build.' an my @BFVER = <$BFVER>; close $BFVER or say 'Cannot start: Broken build.' and exit; if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") { -sssssay 'Cannot start: Broken build.' and exit; + say 'Cannot start: Broken build.' and exit; } undef @BFVER; @@ -112,8 +112,8 @@ our ($APID, %TIMERS); our $DEBUG = 0; our $NUC = 0; if (defined $ARGV[0]) { -ssssforeach (@ARGV) { -ssss given ($_) { + foreach (@ARGV) { + given ($_) { when ('-d') { $DEBUG = 1; } when ('-nuc') { $NUC = 1; } } @@ -135,23 +135,23 @@ our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1) say ' Success'; if (conf_get('die')) { -ssssif ((conf_get('die'))[0][0] == 1) { -ssss say '!!! You didn\'t read the whole config.'; -ssss say '!!! Insert new user then try again.'; -ssss exit; -ssss} + if ((conf_get('die'))[0][0] == 1) { + say '!!! You didn\'t read the whole config.'; + say '!!! Insert new user then try again.'; + exit; + } } # Check for required configuration values. my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype); foreach my $REQCVAL (@REQCVALS) { -ssssif (!conf_get($REQCVAL)) { -ssss my $err = 2; -ssss if ($REQCVAL eq 'expire_logs') { -ssss $err = 1; -ssss } -ssss err($err, "Missing required configuration value: $REQCVAL", 1); -ssss} + if (!conf_get($REQCVAL)) { + my $err = 2; + if ($REQCVAL eq 'expire_logs') { + $err = 1; + } + err($err, "Missing required configuration value: $REQCVAL", 1); + } } undef @REQCVALS; @@ -253,49 +253,49 @@ Core::IRC::clear_usercmd_timer(); our (%PRIVILEGES); # If there are any privsets. if (conf_get('privset')) { -ssss# Get them. -ssssmy %tcprivs = conf_get('privset'); + # Get them. + my %tcprivs = conf_get('privset'); foreach my $tckpriv (keys %tcprivs) { -ssss # For each privset, get the inner values. -ssss my %mcprivs = conf_get("privset:$tckpriv"); + # For each privset, get the inner values. + my %mcprivs = conf_get("privset:$tckpriv"); # Iterate through them. -ssss foreach my $mckpriv (keys %mcprivs) { -ssss # Switch statement for the values. -ssss given ($mckpriv) { -ssss # If it's 'priv', save it as a privilege. -ssss when ('priv') { -ssss if (defined $PRIVILEGES{$tckpriv}) { -ssss # If this privset exists, push to it. -ssss push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0]; -ssss } -ssss else { -ssss # Otherwise, create it. -ssss @{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]); -ssss } -ssss } -ssss # If it's 'inherit', inherit the privileges of another privset. -ssss when ('inherit') { -ssss # If the privset we're inheriting exists, continue. -ssss if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) { -ssss # Iterate through each privilege. -ssss foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) { -ssss # And save them to the privset inheriting them -ssss if (defined $PRIVILEGES{$tckpriv}) { -ssss # If this privset exists, push to it. -ssss push @{ $PRIVILEGES{$tckpriv} }, $_; -ssss } -ssss else { -ssss # Otherwise, create it. -ssss @{ $PRIVILEGES{$tckpriv} } = ($_); -ssss } -ssss } -ssss } -ssss } -ssss } -ssss } -ssss} + foreach my $mckpriv (keys %mcprivs) { + # Switch statement for the values. + given ($mckpriv) { + # If it's 'priv', save it as a privilege. + when ('priv') { + if (defined $PRIVILEGES{$tckpriv}) { + # If this privset exists, push to it. + push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0]; + } + else { + # Otherwise, create it. + @{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]); + } + } + # If it's 'inherit', inherit the privileges of another privset. + when ('inherit') { + # If the privset we're inheriting exists, continue. + if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) { + # Iterate through each privilege. + foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) { + # And save them to the privset inheriting them + if (defined $PRIVILEGES{$tckpriv}) { + # If this privset exists, push to it. + push @{ $PRIVILEGES{$tckpriv} }, $_; + } + else { + # Otherwise, create it. + @{ $PRIVILEGES{$tckpriv} } = ($_); + } + } + } + } + } + } + } } # Successful startup. @@ -313,11 +313,11 @@ if (!$DEBUG) { if ($APID != 0) { alog '* Successfully forked into the background. Process ID: '.$APID; if (!-e "$Bin/auto.pid") { -ssss system "touch $Bin/auto.pid"; -ssss } -ssss open my $FPID, '>', "$Bin/auto.pid" or exit; -ssss print {$FPID} "$APID\n" or exit; -ssss close $FPID or exit; + system "touch $Bin/auto.pid"; + } + open my $FPID, '>', "$Bin/auto.pid" or exit; + print {$FPID} "$APID\n" or exit; + close $FPID or exit; exit; } POSIX::setsid() or err(2, "Can't start a new session: $ERRNO", 1); @@ -331,11 +331,11 @@ API::Std::event_add('on_preconnect'); # Load modules. if (conf_get('module')) { -ssssalog '* Loading modules...'; -ssssdbug '* Loading modules...'; -ssssforeach (@{ (conf_get('module'))[0] }) { -ssss mod_load($_); -ssss} + alog '* Loading modules...'; + dbug '* Loading modules...'; + foreach (@{ (conf_get('module'))[0] }) { + mod_load($_); + } } ## Create sockets. @@ -351,13 +351,13 @@ my $it = 0; foreach my $cskey (keys %cservers) { # Prepare socket data. my %conndata = ( -ssss Proto => 'tcp', - ssssLocalAddr => $cservers{$cskey}{'bind'}[0], -ssss PeerAddr => $cservers{$cskey}{'host'}[0], -ssss PeerPort => $cservers{$cskey}{'port'}[0], + Proto => 'tcp', + LocalAddr => $cservers{$cskey}{'bind'}[0], + PeerAddr => $cservers{$cskey}{'host'}[0], + PeerPort => $cservers{$cskey}{'port'}[0], Timeout => 20, ); -ssss# Set IPv6/SSL data. + # Set IPv6/SSL data. my $use6 = 0; my $usessl = 0; if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; } @@ -383,50 +383,50 @@ ssss# Set IPv6/SSL data. # Create the socket. if ($use6) { -ssss $SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error. + $SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error. err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) and delete $SOCKET{$cskey} and next; } else { if ($usessl) { -ssss $SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error. + $SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error. err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) and delete $SOCKET{$cskey} and next; } else { -ssss $SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error. + $SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error. err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) and delete $SOCKET{$cskey} and next; } } # Send PASS if we have one. -ssssif (defined $cservers{$cskey}{'pass'}[0]) { -ssss socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or -ssss err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) -ssss and next; -ssss} -ssssAPI::Std::event_run('on_preconnect', $cskey); -ssss# Send NICK/USER. -ssssAPI::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]); -sssssocksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or -ssss err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) -ssss and next; -ssss# Add to select. -ssss$SELECT->add($SOCKET{$cskey}); -ssss# Success! -ssssalog '** Successfully connected to server: '.$cskey; -ssssdbug '** Successfully connected to server: '.$cskey; -ssss$it = 1; + if (defined $cservers{$cskey}{'pass'}[0]) { + socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or + err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) + and next; + } + API::Std::event_run('on_preconnect', $cskey); + # Send NICK/USER. + API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]); + socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or + err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) + and next; + # Add to select. + $SELECT->add($SOCKET{$cskey}); + # Success! + alog '** Successfully connected to server: '.$cskey; + dbug '** Successfully connected to server: '.$cskey; + $it = 1; } # Success! if ($it) { -ssssalog '** Success: Connected to server(s).'; -ssssdbug '** Success: Connected to server(s).'; + alog '** Success: Connected to server(s).'; + dbug '** Success: Connected to server(s).'; } else { -sssserr(2, 'No server connections.', 1); + err(2, 'No server connections.', 1); } undef $it; @@ -442,40 +442,40 @@ API::Std::cmd_add('HELP', 2, 0, \%Core::Cmd::HELP_HELP, \&Core::Cmd::cmd_help); # Infinite while loop. while (1) { -ssss# Timer check. -ssssforeach my $tk (keys %TIMERS) { -ssss if ($TIMERS{$tk}{time} <= time) { -ssss &{ $TIMERS{$tk}{sub} }(); -ssss if ($TIMERS{$tk}{type} == 1) { -ssss # If it's type 1, delete from memory. -ssss delete $TIMERS{$tk}; -ssss } -ssss elsif ($TIMERS{$tk}{type} == 2) { -ssss # If it's type 2, reset timer. -ssss $TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs}; -ssss } -ssss else { -ssss # This should never happen. -ssss delete $TIMERS{$tk}; -ssss } -ssss } -ssss} -ssss# Socket check. -ssssforeach my $sock ($SELECT->can_read(1)) { -ssss # Figure out what network is sending us data. -ssss my $sockid; -ssss foreach (keys %SOCKET) { -ssss if ($SOCKET{$_} eq $sock) { $sockid = $_; } -ssss } -ssss # Read the data. -ssss my $idata; -ssss sysread $sock, $idata, POSIX::BUFSIZ, 0; + # Timer check. + foreach my $tk (keys %TIMERS) { + if ($TIMERS{$tk}{time} <= time) { + &{ $TIMERS{$tk}{sub} }(); + if ($TIMERS{$tk}{type} == 1) { + # If it's type 1, delete from memory. + delete $TIMERS{$tk}; + } + elsif ($TIMERS{$tk}{type} == 2) { + # If it's type 2, reset timer. + $TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs}; + } + else { + # This should never happen. + delete $TIMERS{$tk}; + } + } + } + # Socket check. + foreach my $sock ($SELECT->can_read(1)) { + # Figure out what network is sending us data. + my $sockid; + foreach (keys %SOCKET) { + if ($SOCKET{$_} eq $sock) { $sockid = $_; } + } + # Read the data. + my $idata; + sysread $sock, $idata, POSIX::BUFSIZ, 0; -ssss # Check for the data. -ssss if (!defined $idata || length($idata) == 0) { -ssss # Got EOF, close socket -ssss err(2, "Lost connection to $sockid!", 0); -ssss $SELECT->remove($sock); + # Check for the data. + if (!defined $idata || length($idata) == 0) { + # Got EOF, close socket + err(2, "Lost connection to $sockid!", 0); + $SELECT->remove($sock); delete $SOCKET{$sockid}; if (!keys %SOCKET) { # No more connections, stop the program. @@ -486,22 +486,22 @@ ssss $SELECT->remove($sock); exit; } next; -ssss } + } # Read the buffer. -ssss my $data .= $idata; -ssss while ($data =~ s/(.*\n)//) { -ssss my $line = $1; + my $data .= $idata; + while ($data =~ s/(.*\n)//) { + my $line = $1; # Remove the newlines. -ssss chomp $line; -ssss # Debug. -ssss dbug $sockid.' >> '.$line; + chomp $line; + # Debug. + dbug $sockid.' >> '.$line; # Parse data. -ssss Parser::IRC::ircparse($sockid, $line); -ssss } -ssss} + Parser::IRC::ircparse($sockid, $line); + } + } } ############### @@ -511,16 +511,16 @@ ssss} # Send data to socket. sub socksnd { -ssssmy ($svr, $data) = @_; + my ($svr, $data) = @_; if (defined $SOCKET{$svr}) { -ssss syswrite $SOCKET{$svr}, $data."\n", POSIX::BUFSIZ, 0; -ssss dbug "$svr << $data"; -ssss return 1; -ssss} -sssselse { -ssss return 0; -ssss} + syswrite $SOCKET{$svr}, $data."\n", POSIX::BUFSIZ, 0; + dbug "$svr << $data"; + return 1; + } + else { + return 0; + } } # Load a module. diff --git a/install b/install index cd8de31..b9b4c83 100755 --- a/install +++ b/install @@ -19,18 +19,18 @@ our $ERROR = 0; # Iterate through the arguments passed to us. my $features = 'base ssl sqlite'; if (defined $ARGV[0]) { -ssssforeach (@ARGV) { -ssss if ($_ eq '-h' or $_ eq '--help') { -ssss println '*** ./install help ***'; -ssss println ' --enable-sasl - Enable support for SASL.'; + foreach (@ARGV) { + if ($_ eq '-h' or $_ eq '--help') { + println '*** ./install help ***'; + println ' --enable-sasl - Enable support for SASL.'; println ' --enable-ipv6 - Enable support for IPv6.'; println ' --disable-ssl - Disable support for SSL.'; -ssss println '*** End of Help ***'; -ssss exit 1; -ssss } -ssss elsif ($_ eq '--enable-sasl') { -ssss $features .= ' sasl'; -ssss } + println '*** End of Help ***'; + exit 1; + } + elsif ($_ eq '--enable-sasl') { + $features .= ' sasl'; + } elsif ($_ eq '--disable-ssl') { $features =~ s/ ssl//g; } @@ -40,13 +40,13 @@ ssss } elsif ($_ eq '--with-mysql') { $features =~ s/(sqlite|pgsql)/mysql/g; } -ssss elsif ($_ eq '--with-pgsql') { + elsif ($_ eq '--with-pgsql') { $features =~ s/(sqlite|mysql)/pgsql/g; } else { -ssss println "Warning: Unknown option '$_'"; -ssss } -ssss} + println "Warning: Unknown option '$_'"; + } + } } # Check Perl version. @@ -58,32 +58,32 @@ eval { # Check operating system. print "Checking operating system..... $OSNAME - "; if ($OSNAME =~ /dos/i) { -ssssprint "DOS is not supported.\r\n"; + print "DOS is not supported.\r\n"; } elsif ($OSNAME eq "MSWin32") { -ssssprint "Microsoft Windows is not supported. Support is planned for the future.\r\n"; + print "Microsoft Windows is not supported. Support is planned for the future.\r\n"; } elsif ($OSNAME eq "NetWare") { -ssssprint "NetWare is not supported.\r\n"; + print "NetWare is not supported.\r\n"; } elsif ($OSNAME eq "linux") { -ssssprint "OK\n"; + print "OK\n"; } elsif ($OSNAME eq "os2") { -ssssprint "IBM OS/2 is not supported.\r\n"; + print "IBM OS/2 is not supported.\r\n"; } elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) { -ssssprint "OK\r"; + print "OK\r"; } elsif ($OSNAME eq "freebsd") { -ssssprint "OK\n"; + print "OK\n"; } elsif ($OSNAME eq "openbsd") { -ssssprint "OK\n"; + print "OK\n"; } else { -ssssprint "Unknown operating system. Contact support.\r\n"; -}ssss + print "Unknown operating system. Contact support.\r\n"; +} # Check for Perl core modules. println "Checking for core Perl modules....."; @@ -124,19 +124,19 @@ else { println "\0"; println "Building....."; if (!-d "$Bin/build") { -sssssystem "mkdir $Bin/build"; + system "mkdir $Bin/build"; } if (!-e "$Bin/build/time") { -sssssystem "touch $Bin/build/time"; + system "touch $Bin/build/time"; } if (!-e "$Bin/build/os") { -sssssystem "touch $Bin/build/os"; + system "touch $Bin/build/os"; } if (!-e "$Bin/build/perl") { -sssssystem "touch $Bin/build/perl"; + system "touch $Bin/build/perl"; } if (!-e "$Bin/build/ver") { -sssssystem "touch $Bin/build/ver"; + system "touch $Bin/build/ver"; } build($features); diff --git a/lib/API/IRC.pm b/lib/API/IRC.pm index 67e090c..15216a1 100644 --- a/lib/API/IRC.pm +++ b/lib/API/IRC.pm @@ -48,68 +48,68 @@ sub ban # Join a channel. sub cjoin { -ssssmy ($svr, $chan, $key) = @_; -ssss -ssssAuto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan")); -ssss -ssssreturn 1; + my ($svr, $chan, $key) = @_; + + Auto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan")); + + return 1; } # Part a channel. sub cpart { -ssssmy ($svr, $chan, $reason) = @_; -ssss -ssssif (defined $reason) { -ssss Auto::socksnd($svr, "PART $chan :$reason"); -ssss} -sssselse { -ssss Auto::socksnd($svr, "PART $chan :Leaving"); -ssss} + my ($svr, $chan, $reason) = @_; + + if (defined $reason) { + Auto::socksnd($svr, "PART $chan :$reason"); + } + else { + Auto::socksnd($svr, "PART $chan :Leaving"); + } if (defined $Parser::IRC::botchans{$svr}{$chan}) { delete $Parser::IRC::botchans{$svr}{$chan}; } -ssss -ssssreturn 1; + + return 1; } # Set mode(s) on a channel. sub cmode { -ssssmy ($svr, $chan, $modes) = @_; + my ($svr, $chan, $modes) = @_; -ssssAuto::socksnd($svr, "MODE $chan $modes"); -ssss -ssssreturn 1; + Auto::socksnd($svr, "MODE $chan $modes"); + + return 1; } # Set mode(s) on us. sub umode { -ssssmy ($svr, $modes) = @_; -ssss -ssssAuto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes"); -ssss -ssssreturn 1; + my ($svr, $modes) = @_; + + Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes"); + + return 1; } # Send a PRIVMSG. sub privmsg { -ssssmy ($svr, $target, $message) = @_; -ssss -ssssAuto::socksnd($svr, "PRIVMSG $target :$message"); -ssss -ssssreturn 1; + my ($svr, $target, $message) = @_; + + Auto::socksnd($svr, "PRIVMSG $target :$message"); + + return 1; } # Send a NOTICE. sub notice { -ssssmy ($svr, $target, $message) = @_; -ssss -ssssAuto::socksnd($svr, "NOTICE $target :$message"); -ssss -ssssreturn 1; + my ($svr, $target, $message) = @_; + + Auto::socksnd($svr, "NOTICE $target :$message"); + + return 1; } # Send an ACTION PRIVMSG. @@ -125,33 +125,33 @@ sub act # Change bot nickname. sub nick { -ssssmy ($svr, $newnick) = @_; -ssss -ssssAuto::socksnd($svr, "NICK $newnick"); -ssss -ssss$Parser::IRC::botnick{$svr}{newnick} = $newnick; -ssss -ssssreturn 1; + my ($svr, $newnick) = @_; + + Auto::socksnd($svr, "NICK $newnick"); + + $Parser::IRC::botnick{$svr}{newnick} = $newnick; + + return 1; } # Request the users of a channel. sub names { -ssssmy ($svr, $chan) = @_; -ssss -ssssAuto::socksnd($svr, "NAMES $chan"); -ssss -ssssreturn 1; + my ($svr, $chan) = @_; + + Auto::socksnd($svr, "NAMES $chan"); + + return 1; } # Send a topic to the channel. sub topic { -ssssmy ($svr, $chan, $topic) = @_; -ssss -ssssAuto::socksnd($svr, "TOPIC $chan :$topic"); -ssss -ssssreturn 1; + my ($svr, $chan, $topic) = @_; + + Auto::socksnd($svr, "TOPIC $chan :$topic"); + + return 1; } # Kick a user. @@ -167,54 +167,54 @@ sub kick # Quit IRC. sub quit { -ssssmy ($svr, $reason) = @_; -ssss -ssssif (defined $reason) { -ssss Auto::socksnd($svr, "QUIT :$reason"); -ssss} -sssselse { -ssss Auto::socksnd($svr, "QUIT :Leaving"); -ssss} -ssss -ssssdelete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr}); -ssssdelete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr}); -ssss -ssssreturn 1; + my ($svr, $reason) = @_; + + if (defined $reason) { + Auto::socksnd($svr, "QUIT :$reason"); + } + else { + Auto::socksnd($svr, "QUIT :Leaving"); + } + + delete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr}); + delete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr}); + + return 1; } # Get nick, ident and host from a !@ sub usrc { -ssssmy ($ex) = @_; -ssss -ssssmy @si = split('!', $ex); -ssssmy @sii = split('@', $si[1]); -ssss -ssssreturn ( -ssss nick => $si[0], -ssss user => $sii[0], -ssss host => $sii[1] -ssss); + my ($ex) = @_; + + my @si = split('!', $ex); + my @sii = split('@', $si[1]); + + return ( + nick => $si[0], + user => $sii[0], + host => $sii[1] + ); } # Match two IRC masks. sub match_mask { -ssssmy ($mu, $mh) = @_; -ssss -ssss# Prepare the regex. -ssss$mh =~ s/\./\\\./g; -ssss$mh =~ s/\?/\./g; -ssss$mh =~ s/\*/\.\*/g; -ssss$mh = '^'.$mh.'$'; -ssss -ssss# Let's grep the user's mask. -ssssif (grep(/$mh/, $mu)) { -ssss return 1; -ssss} -ssss -ssssreturn 0; + my ($mu, $mh) = @_; + + # Prepare the regex. + $mh =~ s/\./\\\./g; + $mh =~ s/\?/\./g; + $mh =~ s/\*/\.\*/g; + $mh = '^'.$mh.'$'; + + # Let's grep the user's mask. + if (grep(/$mh/, $mu)) { + return 1; + } + + return 0; } diff --git a/lib/API/Log.pm b/lib/API/Log.pm index 8b7f57f..9c2222d 100644 --- a/lib/API/Log.pm +++ b/lib/API/Log.pm @@ -18,11 +18,11 @@ our @EXPORT_OK = qw(println dbug alog slog); # Print with the system newline appended. sub println { -ssssmy ($out) = @_; + my ($out) = @_; -ssssif (!defined $out) { -ssss print $RS; -ssss} + if (!defined $out) { + print $RS; + } else { print $out.$RS; } @@ -33,79 +33,79 @@ ssss} # Print only if in debug mode. sub dbug { -ssssmy ($out) = @_; + my ($out) = @_; -ssssif ($Auto::DEBUG) { -ssss # We're in debug mode; print it out. -ssss say $out; -ssss} + if ($Auto::DEBUG) { + # We're in debug mode; print it out. + say $out; + } -ssssreturn 1; + return 1; } # Log to file. sub alog { -ssssmy ($lmsg) = @_; + my ($lmsg) = @_; -ssss# Expire old logs first. -ssssexpire_logs(); + # Expire old logs first. + expire_logs(); -ssss# Get date and time in the desired format. -ssssmy $date = POSIX::strftime('%Y%m%d', localtime); -ssssmy $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime); + # Get date and time in the desired format. + my $date = POSIX::strftime('%Y%m%d', localtime); + my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime); -ssss# Create var/ if it doesn't exist. -ssssif (!-d "$Auto::Bin/../var") { -ssss mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) -ssss} -ssss# Create var/DATE.log if it doesn't exist. -ssssif (!-e "$Auto::Bin/../var/$date.log") { -ssss system "touch $Auto::Bin/../var/$date.log"; -ssss} + # Create var/ if it doesn't exist. + if (!-d "$Auto::Bin/../var") { + mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) + } + # Create var/DATE.log if it doesn't exist. + if (!-e "$Auto::Bin/../var/$date.log") { + system "touch $Auto::Bin/../var/$date.log"; + } -ssss# Open the logfile, print the log message to it and close it. -ssssopen my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return; -ssssprint {$FLOG} "[$time] $lmsg\n" or return; -ssssclose $FLOG or return; + # Open the logfile, print the log message to it and close it. + open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return; + print {$FLOG} "[$time] $lmsg\n" or return; + close $FLOG or return; -ssssreturn 1; + return 1; } # Expire old logs. sub expire_logs { -ssss# Get configuration value. -ssssmy $celog = (conf_get('expire_logs'))[0][0] or return; + # Get configuration value. + my $celog = (conf_get('expire_logs'))[0][0] or return; -ssss# Check for invalid values. -ssssif ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss # Must be numbers only. -ssss return; -ssss} -sssselsif (!$celog) { -ssss # No expire. -ssss return; -ssss} + # Check for invalid values. + if ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) + # Must be numbers only. + return; + } + elsif (!$celog) { + # No expire. + return; + } -ssss# Iterate through each logfile. -ssssforeach my $file (glob "$Auto::Bin/../var/*") { -ssss my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit) + # Iterate through each logfile. + foreach my $file (glob "$Auto::Bin/../var/*") { + my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit) -ssss # Convert filename to UNIX time. -ssss my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) -ssss my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) -ssss $mm = $mm - 1; -ssss my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) -ssss my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy); + # Convert filename to UNIX time. + my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) + my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) + $mm = $mm - 1; + my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) + my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy); -ssss # If it's older than days, delete it. -ssss if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) -ssss unlink "$Auto::Bin/../var/$file"; -ssss } -ssss} + # If it's older than days, delete it. + if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) + unlink "$Auto::Bin/../var/$file"; + } + } -ssssreturn 1; + return 1; } # Subroutine for logging to an IRC logchan. diff --git a/lib/API/Std.pm b/lib/API/Std.pm index 8c5afd0..93c57a4 100644 --- a/lib/API/Std.pm +++ b/lib/API/Std.pm @@ -11,237 +11,237 @@ use base qw(Exporter); our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS); our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add -ssss cmd_del hook_add hook_del rchook_add rchook_del match_user -ssss has_priv mod_exists ratelimit_check); + cmd_del hook_add hook_del rchook_add rchook_del match_user + has_priv mod_exists ratelimit_check); # Initialize a module. sub mod_init { -ssssmy ($name, $author, $version, $autover, $pkg) = @_; + my ($name, $author, $version, $autover, $pkg) = @_; # Log/debug. -ssssAPI::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); -ssssAPI::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); + API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); + API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); } # Check if this module is compatible with this version of Auto. -ssssif ($autover ne '3.0.0a4' and $autover ne '3.0.0a5') { -ssss API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); -ssss API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); + if ($autover ne '3.0.0a4' and $autover ne '3.0.0a5') { + API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); + API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); } -ssss return; -ssss} + return; + } -ssss# Run the module's _init sub. + # Run the module's _init sub. my $mi = eval($pkg.'::_init();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval) -ssssif ($mi) { -ssss # If successful, add to hash. -ssss $MODULE{$name}{name} = $name; -ssss $MODULE{$name}{version} = $version; -ssss $MODULE{$name}{author} = $author; -ssss $MODULE{$name}{pkg} = $pkg; + if ($mi) { + # If successful, add to hash. + $MODULE{$name}{name} = $name; + $MODULE{$name}{version} = $version; + $MODULE{$name}{author} = $author; + $MODULE{$name}{pkg} = $pkg; -ssss API::Log::dbug('MODULES: '.$name.' successfully loaded.'); -ssss API::Log::alog('MODULES: '.$name.' successfully loaded.'); + API::Log::dbug('MODULES: '.$name.' successfully loaded.'); + API::Log::alog('MODULES: '.$name.' successfully loaded.'); if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.'); } -ssss return 1; -ssss} -sssselse { -ssss # Otherwise, return a failed to load message. -ssss API::Log::dbug('MODULES: Failed to load '.$name.q{.}); -ssss API::Log::alog('MODULES: Failed to load '.$name.q{.}); + return 1; + } + else { + # Otherwise, return a failed to load message. + API::Log::dbug('MODULES: Failed to load '.$name.q{.}); + API::Log::alog('MODULES: Failed to load '.$name.q{.}); if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}); } -ssss return; -ssss} + return; + } } # Check if a module exists. sub mod_exists { -ssssmy ($name) = @_; + my ($name) = @_; -ssssif (defined $API::Std::MODULE{$name}) { return 1; } + if (defined $API::Std::MODULE{$name}) { return 1; } -ssssreturn; + return; } # Void a module. sub mod_void { -ssssmy ($module) = @_; + my ($module) = @_; -ssss# Log/debug. -ssssAPI::Log::dbug('MODULES: Attempting to unload module: '.$module.'...'); -ssssAPI::Log::alog('MODULES: Attempting to unload module: '.$module.'...'); + # Log/debug. + API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...'); + API::Log::alog('MODULES: Attempting to unload module: '.$module.'...'); if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to unload module: '.$module.'...'); } -ssss# Check if this module exists. -ssssif (!defined $MODULE{$module}) { -ssss API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?'); -ssss API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?'); + # Check if this module exists. + if (!defined $MODULE{$module}) { + API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?'); + API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?'); if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?'); } -ssss return; -ssss} + return; + } -ssss# Run the module's _void sub. + # Run the module's _void sub. my $mi = eval($MODULE{$module}{pkg}.'::_void();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval) -ssssif ($mi) { -ssss # If successful, delete class from program and delete module from hash. -ssss Class::Unload->unload($MODULE{$module}{pkg}); -ssss delete $MODULE{$module}; -ssss API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.}); -ssss API::Log::alog('MODULES: Successfully unloaded '.$module.q{.}); + if ($mi) { + # If successful, delete class from program and delete module from hash. + Class::Unload->unload($MODULE{$module}{pkg}); + delete $MODULE{$module}; + API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.}); + API::Log::alog('MODULES: Successfully unloaded '.$module.q{.}); if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Successfully unloaded '.$module.q{.}); } -ssss return 1; -ssss} -sssselse { -ssss # Otherwise, return a failed to unload message. -ssss API::Log::dbug('MODULES: Failed to unload '.$module.q{.}); -ssss API::Log::alog('MODULES: Failed to unload '.$module.q{.}); + return 1; + } + else { + # Otherwise, return a failed to unload message. + API::Log::dbug('MODULES: Failed to unload '.$module.q{.}); + API::Log::alog('MODULES: Failed to unload '.$module.q{.}); if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}); } -ssss return; -ssss} + return; + } } # Add a command to Auto. sub cmd_add { -ssssmy ($cmd, $lvl, $priv, $help, $sub) = @_; -ssss$cmd = uc $cmd; + my ($cmd, $lvl, $priv, $help, $sub) = @_; + $cmd = uc $cmd; -ssssif (defined $API::Std::CMDS{$cmd}) { return; } -ssssif ($lvl =~ m/[^0-3]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting) + if (defined $API::Std::CMDS{$cmd}) { return; } + if ($lvl =~ m/[^0-3]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss$API::Std::CMDS{$cmd}{lvl} = $lvl; -ssss$API::Std::CMDS{$cmd}{help} = $help; -ssss$API::Std::CMDS{$cmd}{priv} = $priv; -ssss$API::Std::CMDS{$cmd}{'sub'} = $sub; + $API::Std::CMDS{$cmd}{lvl} = $lvl; + $API::Std::CMDS{$cmd}{help} = $help; + $API::Std::CMDS{$cmd}{priv} = $priv; + $API::Std::CMDS{$cmd}{'sub'} = $sub; -ssssreturn 1; + return 1; } # Delete a command from Auto. sub cmd_del { -ssssmy ($cmd) = @_; -ssss$cmd = uc $cmd; + my ($cmd) = @_; + $cmd = uc $cmd; -ssssif (defined $API::Std::CMDS{$cmd}) { -ssss delete $API::Std::CMDS{$cmd}; -ssss} -sssselse { -ssss return; -ssss} + if (defined $API::Std::CMDS{$cmd}) { + delete $API::Std::CMDS{$cmd}; + } + else { + return; + } -ssssreturn 1; + return 1; } # Add an event to Auto. sub event_add { -ssssmy ($name) = @_; + my ($name) = @_; -ssssif (!defined $EVENTS{lc $name}) { -ssss $EVENTS{lc $name} = 1; -ssss return 1; -ssss} -sssselse { -ssss API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...'); -ssss return; -ssss} + if (!defined $EVENTS{lc $name}) { + $EVENTS{lc $name} = 1; + return 1; + } + else { + API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...'); + return; + } } # Delete an event from Auto. sub event_del { -ssssmy ($name) = @_; + my ($name) = @_; -ssssif (defined $EVENTS{lc $name}) { -ssss delete $EVENTS{lc $name}; -ssss delete $HOOKS{lc $name}; -ssss return 1; -ssss} -sssselse { -ssss API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...'); -ssss return; -ssss} + if (defined $EVENTS{lc $name}) { + delete $EVENTS{lc $name}; + delete $HOOKS{lc $name}; + return 1; + } + else { + API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...'); + return; + } } # Trigger an event. sub event_run { -ssssmy ($event, @args) = @_; + my ($event, @args) = @_; -ssssif (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) { -ssss foreach my $hk (keys %{ $HOOKS{lc $event} }) { -ssss my $ri = &{ $HOOKS{lc $event}{$hk} }(@args); + if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) { + foreach my $hk (keys %{ $HOOKS{lc $event} }) { + my $ri = &{ $HOOKS{lc $event}{$hk} }(@args); if ($ri == -1) { last; } -ssss } -ssss} + } + } -ssssreturn 1; + return 1; } # Add a hook to Auto. sub hook_add { -ssssmy ($event, $name, $sub) = @_; + my ($event, $name, $sub) = @_; -ssssif (!defined $API::Std::HOOKS{lc $name}) { -ssss if (defined $API::Std::EVENTS{lc $event}) { -ssss $API::Std::HOOKS{lc $event}{lc $name} = $sub; -ssss return 1; -ssss } -ssss else { -ssss return; -ssss } -ssss} -sssselse { -ssss return; -ssss} + if (!defined $API::Std::HOOKS{lc $name}) { + if (defined $API::Std::EVENTS{lc $event}) { + $API::Std::HOOKS{lc $event}{lc $name} = $sub; + return 1; + } + else { + return; + } + } + else { + return; + } } # Delete a hook from Auto. sub hook_del { -ssssmy ($event, $name) = @_; + my ($event, $name) = @_; -ssssif (defined $API::Std::HOOKS{lc $event}{lc $name}) { -ssss delete $API::Std::HOOKS{lc $event}{lc $name}; -ssss return 1; -ssss} -sssselse { -ssss return; -ssss} + if (defined $API::Std::HOOKS{lc $event}{lc $name}) { + delete $API::Std::HOOKS{lc $event}{lc $name}; + return 1; + } + else { + return; + } } # Add a timer to Auto. sub timer_add { -ssssmy ($name, $type, $time, $sub) = @_; -ssss$name = lc $name; + my ($name, $type, $time, $sub) = @_; + $name = lc $name; -ssss# Check for invalid type/time. -ssssif ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss return; -ssss} -ssssif ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss return; -ssss} + # Check for invalid type/time. + if ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) + return; + } + if ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) + return; + } -ssssif (!defined $Auto::TIMERS{$name}) { -ssss $Auto::TIMERS{$name}{type} = $type; -ssss $Auto::TIMERS{$name}{time} = time + $time; -ssss if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; } -ssss $Auto::TIMERS{$name}{sub} = $sub; -ssss return 1; -ssss} + if (!defined $Auto::TIMERS{$name}) { + $Auto::TIMERS{$name}{type} = $type; + $Auto::TIMERS{$name}{time} = time + $time; + if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; } + $Auto::TIMERS{$name}{sub} = $sub; + return 1; + } return 1; } @@ -249,123 +249,123 @@ ssss} # Delete a timer from Auto. sub timer_del { -ssssmy ($name) = @_; -ssss$name = lc $name; + my ($name) = @_; + $name = lc $name; -ssssif (defined $Auto::TIMERS{$name}) { -ssss delete $Auto::TIMERS{$name}; -ssss return 1; -ssss} + if (defined $Auto::TIMERS{$name}) { + delete $Auto::TIMERS{$name}; + return 1; + } -ssssreturn; + return; } # Hook onto a raw command. sub rchook_add { -ssssmy ($cmd, $sub) = @_; -ssss$cmd = uc $cmd; + my ($cmd, $sub) = @_; + $cmd = uc $cmd; -ssssif (defined $Parser::IRC::RAWC{$cmd}) { return; } + if (defined $Parser::IRC::RAWC{$cmd}) { return; } -ssss$Parser::IRC::RAWC{$cmd} = $sub; + $Parser::IRC::RAWC{$cmd} = $sub; -ssssreturn 1; + return 1; } # Delete a raw command hook. sub rchook_del { -ssssmy ($cmd) = @_; -ssss$cmd = uc $cmd; + my ($cmd) = @_; + $cmd = uc $cmd; -ssssif (!defined $Parser::IRC::RAWC{$cmd}) { return; } + if (!defined $Parser::IRC::RAWC{$cmd}) { return; } -ssssdelete $Parser::IRC::RAWC{$cmd}; + delete $Parser::IRC::RAWC{$cmd}; -ssssreturn 1; + return 1; } # Configuration value getter. sub conf_get { -ssssmy ($value) = @_; + my ($value) = @_; -ssss# Create an array out of the value. -ssssmy @val; -ssssif ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss @val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss} -sssselse { -ssss @val = ($value); -ssss} -ssss# Undefine this as it's unnecessary now. -ssssundef $value; + # Create an array out of the value. + my @val; + if ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) + @val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting) + } + else { + @val = ($value); + } + # Undefine this as it's unnecessary now. + undef $value; -ssss# Get the count of elements in the array. -ssssmy $count = scalar @val; + # Get the count of elements in the array. + my $count = scalar @val; -ssss# Return the requested configuration value(s). -ssssif ($count == 1) { -ssss if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') { -ssss return %{ $Auto::SETTINGS{$val[0]} }; -ssss } -ssss else { -ssss return $Auto::SETTINGS{$val[0]}; -ssss } -ssss} -sssselsif ($count == 2) { -ssss if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') { -ssss return %{ $Auto::SETTINGS{$val[0]}{$val[1]} }; -ssss } -ssss else { -ssss return $Auto::SETTINGS{$val[0]}{$val[1]}; -ssss } -ssss} -sssselsif ($count == 3) { -ssss if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') { -ssss return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} }; -ssss } -ssss else { -ssss return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]}; -ssss } -ssss} -sssselse { -ssss return; -ssss} + # Return the requested configuration value(s). + if ($count == 1) { + if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') { + return %{ $Auto::SETTINGS{$val[0]} }; + } + else { + return $Auto::SETTINGS{$val[0]}; + } + } + elsif ($count == 2) { + if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') { + return %{ $Auto::SETTINGS{$val[0]}{$val[1]} }; + } + else { + return $Auto::SETTINGS{$val[0]}{$val[1]}; + } + } + elsif ($count == 3) { + if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') { + return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} }; + } + else { + return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]}; + } + } + else { + return; + } } # Translation subroutine. sub trans { my $id = shift; -ssss$id =~ s/ /_/gsm; + $id =~ s/ /_/gsm; -ssssif (defined $API::Std::LANGE{$id}) { -ssss return sprintf $API::Std::LANGE{$id}, @_; -ssss} -sssselse { -ssss $id =~ s/_/ /gsm; -ssss return $id; -ssss} + if (defined $API::Std::LANGE{$id}) { + return sprintf $API::Std::LANGE{$id}, @_; + } + else { + $id =~ s/_/ /gsm; + return $id; + } } # Match user subroutine. sub match_user { -ssssmy (%user) = @_; + my (%user) = @_; -ssss# Get data from config. + # Get data from config. if (!conf_get('user')) { return; } -ssssmy %uhp = conf_get('user'); + my %uhp = conf_get('user'); -ssssforeach my $userkey (keys %uhp) { -ssss # For each user block. -ssss my %ulhp = %{ $uhp{$userkey} }; -ssss foreach my $uhk (keys %ulhp) { + foreach my $userkey (keys %uhp) { + # For each user block. + my %ulhp = %{ $uhp{$userkey} }; + foreach my $uhk (keys %ulhp) { # For each user. -ssss if ($uhk eq 'net') { + if ($uhk eq 'net') { if (defined $user{svr}) { if (lc $user{svr} ne lc(($ulhp{$uhk})[0][0])) { # config.user:net conflicts with irc.user:svr. @@ -374,13 +374,13 @@ ssss if ($uhk eq 'net') { } } elsif ($uhk eq 'mask') { -ssss # Put together the user information. -ssss my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host}; -ssss if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) { -ssss # We've got a host match. -ssss return $userkey; -ssss } -ssss } + # Put together the user information. + my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host}; + if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) { + # We've got a host match. + return $userkey; + } + } elsif ($uhk eq 'chanstatus' and defined $ulhp{'net'}) { my ($ccst, $ccnm) = split m/[:]/sm, ($ulhp{$uhk})[0][0]; ## no critic qw(RegularExpressions::RequireExtendedFormatting) my $svr = $ulhp{net}[0]; @@ -401,28 +401,28 @@ ssss } } } } -ssss } -ssss} + } + } -ssssreturn; + return; } # Privilege subroutine. sub has_priv { -ssssmy ($cuser, $cpriv) = @_; + my ($cuser, $cpriv) = @_; -ssssif (conf_get("user:$cuser:privs")) { -ssss my $cups = (conf_get("user:$cuser:privs"))[0][0]; + if (conf_get("user:$cuser:privs")) { + my $cups = (conf_get("user:$cuser:privs"))[0][0]; -ssss if (defined $Auto::PRIVILEGES{$cups}) { -ssss foreach (@{ $Auto::PRIVILEGES{$cups} }) { -ssss if ($_ eq $cpriv or $_ eq 'ALL') { return 1; } -ssss } -ssss } -ssss} + if (defined $Auto::PRIVILEGES{$cups}) { + foreach (@{ $Auto::PRIVILEGES{$cups} }) { + if ($_ eq $cpriv or $_ eq 'ALL') { return 1; } + } + } + } -ssssreturn; + return; } # Ratelimit check subroutine. @@ -461,59 +461,59 @@ sub ratelimit_check # Error subroutine. sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms) { -ssssmy ($lvl, $msg, $fatal) = @_; + my ($lvl, $msg, $fatal) = @_; -ssss# Check for an invalid level. -ssssif ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss return; -ssss} -ssssif ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss return; -ssss} + # Check for an invalid level. + if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) + return; + } + if ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) + return; + } -ssss# Level 1: Print to screen. -ssssif ($lvl >= 1) { -ssss say "ERROR: $msg"; -ssss} -ssss# Level 2: Log to file. -ssssif ($lvl >= 2) { -ssss API::Log::alog("ERROR: $msg"); -ssss} + # Level 1: Print to screen. + if ($lvl >= 1) { + say "ERROR: $msg"; + } + # Level 2: Log to file. + if ($lvl >= 2) { + API::Log::alog("ERROR: $msg"); + } # Level 3: Log to IRC. if ($lvl >= 3) { API::Log::slog("ERROR: $msg"); } -ssss# If it's a fatal error, exit the program. -ssssif ($fatal) { exit; } + # If it's a fatal error, exit the program. + if ($fatal) { exit; } -ssssreturn 1; + return 1; } # Warn subroutine. sub awarn { -ssssmy ($lvl, $msg) = @_; + my ($lvl, $msg) = @_; -ssss# Check for an invalid level. -ssssif ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) -ssss return; -ssss} + # Check for an invalid level. + if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting) + return; + } -ssss# Level 1: Print to screen. -ssssif ($lvl >= 1) { -ssss say "WARNING: $msg"; -ssss} -ssss# Level 2: Log to file. -ssssif ($lvl >= 2) { -ssss API::Log::alog("WARNING: $msg"); -ssss} + # Level 1: Print to screen. + if ($lvl >= 1) { + say "WARNING: $msg"; + } + # Level 2: Log to file. + if ($lvl >= 2) { + API::Log::alog("WARNING: $msg"); + } # Level 3: Log to IRC. if ($lvl >= 3) { API::Log::slog("WARNING: $msg"); } -ssssreturn 1; + return 1; } diff --git a/lib/Core/IRC.pm b/lib/Core/IRC.pm index c92fedc..478ccc1 100644 --- a/lib/Core/IRC.pm +++ b/lib/Core/IRC.pm @@ -43,22 +43,22 @@ hook_add("on_quit", "quit_update_chanusers", sub { hook_add("on_connect", "on_connect_modes", sub { my ($svr) = @_; -ssssif (conf_get("server:$svr:modes")) { -ssss my $connmodes = (conf_get("server:$svr:modes"))[0][0]; -ssss API::IRC::umode($svr, $connmodes); -ssss} + if (conf_get("server:$svr:modes")) { + my $connmodes = (conf_get("server:$svr:modes"))[0][0]; + API::IRC::umode($svr, $connmodes); + } return 1; }); # Plaintext auth. hook_add("on_connect", "plaintext_auth", sub { -ssssmy ($svr) = @_; + my ($svr) = @_; if (conf_get("server:$svr:idstr")) { -ssss my $idstr = (conf_get("server:$svr:idstr"))[0][0]; -ssss Auto::socksnd($svr, $idstr); -ssss} + my $idstr = (conf_get("server:$svr:idstr"))[0][0]; + Auto::socksnd($svr, $idstr); + } return 1; }); @@ -67,14 +67,14 @@ ssss} hook_add("on_connect", "autojoin", sub { my ($svr) = @_; -ssss# Get the auto-join from the config. -ssssmy @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] }; -ssss -ssss# Join the channels. -ssssif (!defined $cajoin[1]) { -ssss # For single-line ajoins. -ssss my @sajoin = split(',', $cajoin[0]); -ssss + # Get the auto-join from the config. + my @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] }; + + # Join the channels. + if (!defined $cajoin[1]) { + # For single-line ajoins. + my @sajoin = split(',', $cajoin[0]); + foreach (@sajoin) { # Check if a key was specified. if ($_ =~ m/\s/xsm) { @@ -84,13 +84,13 @@ ssss } else { # Else join without one. -ssss API::IRC::cjoin($svr, $_); + API::IRC::cjoin($svr, $_); } } -ssss} -sssselse { -ssss # For multi-line ajoins. -ssss foreach (@cajoin) { + } + else { + # For multi-line ajoins. + foreach (@cajoin) { # Check if a key was specified. if ($_ =~ m/\s/xsm) { # There was, join with it. diff --git a/lib/Parser/Config.pm b/lib/Parser/Config.pm index d96df6a..313ca68 100644 --- a/lib/Parser/Config.pm +++ b/lib/Parser/Config.pm @@ -12,18 +12,18 @@ sub new my ($file) = @_; my $self = bless {}, $class; -ssss# Check to see if the configuration file exists. -ssssif (!-e "$Auto::Bin/../etc/$file") { -ssss return 0; -ssss} -ssss -ssss# Open, read and close the config. -ssssopen(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0; -ssssmy @cosfl = <$FCONF> or return 0; -ssssclose $FCONF or return 0; -ssss -ssss# Save it to self variable. -ssss$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file"; + # Check to see if the configuration file exists. + if (!-e "$Auto::Bin/../etc/$file") { + return 0; + } + + # Open, read and close the config. + open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0; + my @cosfl = <$FCONF> or return 0; + close $FCONF or return 0; + + # Save it to self variable. + $self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file"; return $self; } @@ -31,148 +31,148 @@ ssss$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file"; # Parse the configuration file. sub parse { -ssss# Get the path to the file. -ssssmy $self = shift; -ssssmy $file = $self->{'config'}->{'path'}; -ssssmy $blk = 0; -ssssmy (%rs); -ssss -ssss# Open, read and close it. -ssssopen(my $FCONF, q{<}, "$file") or return 0; -ssssmy @fbuf = <$FCONF> or return 0; -ssssclose $FCONF or return 0; -ssss -ssss# Iterate the file. -ssssforeach my $buff (@fbuf) { -ssss # Main newline buffer. -ssss if (defined $buff) { -ssss # If the line begins with a #, it's a comment so ignore it. -ssss if (substr($buff, 0, 1) eq '#') { -ssss next; -ssss } -ssss -ssss if ($buff =~ m/;/) { -ssss # Semicolon buffer. -ssss my @asbuf = split(';', $buff); -ssss foreach my $asbuff (@asbuf) { -ssss if (defined $asbuff) { -ssss -ssss # Space buffer. -ssss my @ebuf = split(' ', $asbuff); -ssss if (!defined $ebuf[0] or !defined $ebuf[1]) { -ssss # Garbage. Ignoring. -ssss next; -ssss } -ssss my $param = $ebuf[1]; -ssss -ssss if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') { -ssss # Multi-word string. -ssss $param = substr($param, 1); -ssss -ssss for (my $i = 2; $i < scalar(@ebuf); $i++) { -ssss if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') { -ssss $param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1); -ssss last; -ssss } -ssss else { -ssss $param .= " ".$ebuf[$i]; -ssss } -ssss } -ssss } -ssss elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') { -ssss # Single-word string. -ssss $param = substr($param, 1, length($ebuf[1]) - 2); -ssss } -ssss elsif ($param =~ m/[0-9]/) { -ssss # Numeric. -ssss $param =~ s/[^0-9.]//g; -ssss } -ssss else { -ssss # Garbage. -ssss next; -ssss } -ssss -ssss my @param = ($param); -ssss -ssss unless (!$blk) { -ssss # We're inside a block. -ssss if ($blk =~ m/@@@/) { -ssss # We're inside a block with a parameter. -ssss my @sblk = split('@@@', $blk); -ssss -ssss # Check to see if this config option already exists. -ssss if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) { -ssss # It does, so merely push this second one to the existing array. -ssss push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param); -ssss } -ssss else { -ssss # It doesn't, create it as an array. -ssss @{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param; -ssss } -ssss } -ssss else { -ssss # We're inside a block with no parameter. -ssss -ssss # Check to see if this config option already exists. -ssss if (defined $rs{$blk}{$ebuf[0]}) { -ssss # It does, so merely push this second one to the existing array. + # Get the path to the file. + my $self = shift; + my $file = $self->{'config'}->{'path'}; + my $blk = 0; + my (%rs); + + # Open, read and close it. + open(my $FCONF, q{<}, "$file") or return 0; + my @fbuf = <$FCONF> or return 0; + close $FCONF or return 0; + + # Iterate the file. + foreach my $buff (@fbuf) { + # Main newline buffer. + if (defined $buff) { + # If the line begins with a #, it's a comment so ignore it. + if (substr($buff, 0, 1) eq '#') { + next; + } + + if ($buff =~ m/;/) { + # Semicolon buffer. + my @asbuf = split(';', $buff); + foreach my $asbuff (@asbuf) { + if (defined $asbuff) { + + # Space buffer. + my @ebuf = split(' ', $asbuff); + if (!defined $ebuf[0] or !defined $ebuf[1]) { + # Garbage. Ignoring. + next; + } + my $param = $ebuf[1]; + + if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') { + # Multi-word string. + $param = substr($param, 1); + + for (my $i = 2; $i < scalar(@ebuf); $i++) { + if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') { + $param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1); + last; + } + else { + $param .= " ".$ebuf[$i]; + } + } + } + elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') { + # Single-word string. + $param = substr($param, 1, length($ebuf[1]) - 2); + } + elsif ($param =~ m/[0-9]/) { + # Numeric. + $param =~ s/[^0-9.]//g; + } + else { + # Garbage. + next; + } + + my @param = ($param); + + unless (!$blk) { + # We're inside a block. + if ($blk =~ m/@@@/) { + # We're inside a block with a parameter. + my @sblk = split('@@@', $blk); + + # Check to see if this config option already exists. + if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) { + # It does, so merely push this second one to the existing array. + push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param); + } + else { + # It doesn't, create it as an array. + @{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param; + } + } + else { + # We're inside a block with no parameter. + + # Check to see if this config option already exists. + if (defined $rs{$blk}{$ebuf[0]}) { + # It does, so merely push this second one to the existing array. push(@{ $rs{$blk}{$ebuf[0]} }, $param); -ssss } -ssss else { -ssss # It doesn't, create it as an array. -ssss @{ $rs{$blk}{$ebuf[0]} } = @param; -ssss } -ssss } -ssss } -ssss else { -ssss # We're not inside a block. -ssss -ssss # Check to see if this config option already exists. -ssss if (defined $rs{$ebuf[0]}) { -ssss # It does, so merely push this second one to the existing array. -ssss push(@{ $rs{$ebuf[0]} }, $param); -ssss } -ssss else { -ssss # It doesn't, create it as an array. -ssss @{ $rs{$ebuf[0]} } = @param; -ssss } -ssss } -ssss } -ssss } -ssss } -ssss else { -ssss # No semicolon space buffer. -ssss my @ebuf = split(' ', $buff); -ssss -ssss if (!defined $ebuf[0]) { -ssss # Garbage. Ignoring. -ssss next; -ssss } -ssss -ssss if (defined $ebuf[1]) { -ssss if ($ebuf[1] eq '{') { -ssss # This is the beginning of a block with no parameter. + } + else { + # It doesn't, create it as an array. + @{ $rs{$blk}{$ebuf[0]} } = @param; + } + } + } + else { + # We're not inside a block. + + # Check to see if this config option already exists. + if (defined $rs{$ebuf[0]}) { + # It does, so merely push this second one to the existing array. + push(@{ $rs{$ebuf[0]} }, $param); + } + else { + # It doesn't, create it as an array. + @{ $rs{$ebuf[0]} } = @param; + } + } + } + } + } + else { + # No semicolon space buffer. + my @ebuf = split(' ', $buff); + + if (!defined $ebuf[0]) { + # Garbage. Ignoring. + next; + } + + if (defined $ebuf[1]) { + if ($ebuf[1] eq '{') { + # This is the beginning of a block with no parameter. $blk = $ebuf[0]; -ssss } -ssss elsif (defined $ebuf[2]) { -ssss if ($ebuf[2] eq '{') { -ssss # This is the beginning of a block with a parameter. -ssss my $param = $ebuf[1]; -ssss $param =~ s/"//g; -ssss $blk = $ebuf[0].'@@@'.$param; -ssss } -ssss } -ssss } -ssss if ($ebuf[0] eq '}') { -ssss # This is the end of a block. -ssss $blk = 0; -ssss } -ssss } -ssss } -ssss} -ssss -ssss# Return the configuration data. -ssssreturn %rs; + } + elsif (defined $ebuf[2]) { + if ($ebuf[2] eq '{') { + # This is the beginning of a block with a parameter. + my $param = $ebuf[1]; + $param =~ s/"//g; + $blk = $ebuf[0].'@@@'.$param; + } + } + } + if ($ebuf[0] eq '}') { + # This is the end of a block. + $blk = 0; + } + } + } + } + + # Return the configuration data. + return %rs; } diff --git a/lib/Parser/IRC.pm b/lib/Parser/IRC.pm index 34b2ad0..5bf1902 100644 --- a/lib/Parser/IRC.pm +++ b/lib/Parser/IRC.pm @@ -9,26 +9,26 @@ use API::IRC; # Raw parsing hash. our %RAWC = ( -ssss'001' => \&num001, -ssss'005' => \&num005, -ssss'353' => \&num353, -ssss'432' => \&num432, -ssss'433' => \&num433, -ssss'438' => \&num438, -ssss'465' => \&num465, -ssss'471' => \&num471, -ssss'473' => \&num473, -ssss'474' => \&num474, -ssss'475' => \&num475, -ssss'477' => \&num477, -ssss'JOIN' => \&cjoin, + '001' => \&num001, + '005' => \&num005, + '353' => \&num353, + '432' => \&num432, + '433' => \&num433, + '438' => \&num438, + '465' => \&num465, + '471' => \&num471, + '473' => \&num473, + '474' => \&num474, + '475' => \&num475, + '477' => \&num477, + 'JOIN' => \&cjoin, 'KICK' => \&kick, 'MODE' => \&mode, -ssss'NICK' => \&nick, -ssss'NOTICE' => \¬ice, + 'NICK' => \&nick, + 'NOTICE' => \¬ice, 'PART' => \&part, -ssss'PRIVMSG' => \&privmsg, -ssss'QUIT' => \&quit, + 'PRIVMSG' => \&privmsg, + 'QUIT' => \&quit, 'TOPIC' => \&topic, ); @@ -50,33 +50,33 @@ API::Std::event_add("on_topic"); # Parse raw data. sub ircparse { -ssssmy ($svr, $data) = @_; -ssss -ssss# Split spaces into @ex. -ssssmy @ex = split /\s+/, $data; + my ($svr, $data) = @_; + + # Split spaces into @ex. + my @ex = split /\s+/, $data; -ssss# Make sure there is enough data. -ssssif (defined $ex[0] and defined $ex[1]) { -ssss # If it's a ping... -ssss if ($ex[0] eq 'PING') { -ssss # send a PONG. -ssss Auto::socksnd($svr, "PONG ".$ex[1]); -ssss } -ssss # If it's AUTHENTICATE -ssss elsif ($ex[0] eq 'AUTHENTICATE') { -ssss if (API::Std::mod_exists("SASLAuth")) { + # Make sure there is enough data. + if (defined $ex[0] and defined $ex[1]) { + # If it's a ping... + if ($ex[0] eq 'PING') { + # send a PONG. + Auto::socksnd($svr, "PONG ".$ex[1]); + } + # If it's AUTHENTICATE + elsif ($ex[0] eq 'AUTHENTICATE') { + if (API::Std::mod_exists("SASLAuth")) { M::SASLAuth::handle_authenticate($svr, @ex); -ssss } -ssss } -ssss else { -ssss # otherwise, check %RAWC for ex[1]. -ssss if (defined $RAWC{$ex[1]}) { -ssss &{ $RAWC{$ex[1]} }($svr, @ex); -ssss } -ssss } -ssss} -ssss -ssssreturn 1; + } + } + else { + # otherwise, check %RAWC for ex[1]. + if (defined $RAWC{$ex[1]}) { + &{ $RAWC{$ex[1]} }($svr, @ex); + } + } + } + + return 1; } ########################### @@ -87,41 +87,41 @@ ssssreturn 1; # Successful connection. sub num001 { -ssssmy ($svr, @ex) = @_; -ssss -ssss$got_001{$svr} = 1; -ssss -ssss# In case we don't get NICK from the server. -ssssif (defined $botnick{$svr}{newnick}) { -ssss $botnick{$svr}{nick} = $botnick{$svr}{newnick}; -ssss delete $botnick{$svr}{newnick}; -ssss} + my ($svr, @ex) = @_; + + $got_001{$svr} = 1; + + # In case we don't get NICK from the server. + if (defined $botnick{$svr}{newnick}) { + $botnick{$svr}{nick} = $botnick{$svr}{newnick}; + delete $botnick{$svr}{newnick}; + } # Trigger on_connect. API::Std::event_run("on_connect", $svr); -ssss -ssssreturn 1; + + return 1; } # Parse: Numeric:005 # Prefixes and channel modes. sub num005 { -ssssmy ($svr, @ex) = @_; -ssss -ssss# Find PREFIX and CHANMODES. -ssssforeach my $ex (@ex) { -ssss if ($ex =~ m/^PREFIX/xsm) { -ssss # Found PREFIX. -ssss my $rpx = substr($ex, 8); -ssss my ($pm, $pp) = split('\)', $rpx); -ssss my @apm = split(//, $pm); -ssss my @app = split(//, $pp); -ssss foreach my $ppm (@apm) { -ssss # Store data. -ssss $csprefix{$svr}{$ppm} = shift(@app); -ssss } -ssss } + my ($svr, @ex) = @_; + + # Find PREFIX and CHANMODES. + foreach my $ex (@ex) { + if ($ex =~ m/^PREFIX/xsm) { + # Found PREFIX. + my $rpx = substr($ex, 8); + my ($pm, $pp) = split('\)', $rpx); + my @apm = split(//, $pm); + my @app = split(//, $pp); + foreach my $ppm (@apm) { + # Store data. + $csprefix{$svr}{$ppm} = shift(@app); + } + } elsif ($ex =~ m/^CHANMODES/xsm) { # Found CHANMODES. my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10); @@ -134,186 +134,186 @@ ssss } # Modes without parameter. foreach (split(//, $mts)) { $chanmodes{$svr}{$_} = 4; } } -ssss} -ssss -ssssreturn 1; + } + + return 1; } # Parse: Numeric:353 # NAMES reply. sub num353 { -ssssmy ($svr, @ex) = @_; -ssss -ssss# Get rid of the colon. -ssss$ex[5] = substr($ex[5], 1); -ssss# Delete the old chanusers hash if it exists. -ssssdelete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]}); -ssss# Iterate through each user. -ssssfor (my $i = 5; $i < scalar(@ex); $i++) { -ssss my $fi = 0; -ssss foreach (keys %{ $csprefix{$svr} }) { -ssss # Check if the user has status in the channel. -ssss if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) { -ssss # He/she does. Lets set that. -ssss if (defined $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))}) { -ssss # If the user has multiple statuses. -ssss $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} .= $_; -ssss } -ssss else { -ssss # Or not. -ssss $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_; -ssss } -ssss $fi = 1; -ssss } -ssss } -ssss # They had status, so go to the next user. -ssss next if $fi; -ssss # They didn't, set them as a normal user. -ssss if (!defined $chanusers{$svr}{$ex[4]}{lc($ex[$i])}) { -ssss $chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1; -ssss } -ssss} -ssss -ssssreturn 1; + my ($svr, @ex) = @_; + + # Get rid of the colon. + $ex[5] = substr($ex[5], 1); + # Delete the old chanusers hash if it exists. + delete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]}); + # Iterate through each user. + for (my $i = 5; $i < scalar(@ex); $i++) { + my $fi = 0; + foreach (keys %{ $csprefix{$svr} }) { + # Check if the user has status in the channel. + if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) { + # He/she does. Lets set that. + if (defined $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))}) { + # If the user has multiple statuses. + $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} .= $_; + } + else { + # Or not. + $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_; + } + $fi = 1; + } + } + # They had status, so go to the next user. + next if $fi; + # They didn't, set them as a normal user. + if (!defined $chanusers{$svr}{$ex[4]}{lc($ex[$i])}) { + $chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1; + } + } + + return 1; } # Parse: Numeric:432 # Erroneous nickname. sub num432 { -ssssmy ($svr, undef) = @_; -ssss -ssssif ($got_001{$svr}) { -ssss err(3, "Got error from server[".$svr."]: Erroneous nickname.", 0); -ssss} -sssselse { -ssss err(2, "Got error from server[".$svr."] before 001: Erroneous nickname. Closing connection.", 0); -ssss API::IRC::quit($svr, "An error occurred."); -ssss} -ssss -ssssdelete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick}); -ssss -ssssreturn 1; + my ($svr, undef) = @_; + + if ($got_001{$svr}) { + err(3, "Got error from server[".$svr."]: Erroneous nickname.", 0); + } + else { + err(2, "Got error from server[".$svr."] before 001: Erroneous nickname. Closing connection.", 0); + API::IRC::quit($svr, "An error occurred."); + } + + delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick}); + + return 1; } # Parse: Numeric:433 # Nickname is already in use. sub num433 { -ssssmy ($svr, undef) = @_; -ssss -ssssif (defined $botnick{$svr}{newnick}) { -ssss API::IRC::nick($svr, $botnick{$svr}{newnick}."_"); -ssss delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick}); -ssss} -ssss -ssssreturn 1; + my ($svr, undef) = @_; + + if (defined $botnick{$svr}{newnick}) { + API::IRC::nick($svr, $botnick{$svr}{newnick}."_"); + delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick}); + } + + return 1; } # Parse: Numeric:438 # Nick change too fast. sub num438 { -ssssmy ($svr, @ex) = @_; -ssss -ssssif (defined $botnick{$svr}{newnick}) { -ssss API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub { -ssss API::IRC::nick($Parser::IRC::botnick{$svr}{newnick}); -ssss delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick}); -ssss }); -ssss} -ssss -ssssreturn 1; + my ($svr, @ex) = @_; + + if (defined $botnick{$svr}{newnick}) { + API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub { + API::IRC::nick($Parser::IRC::botnick{$svr}{newnick}); + delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick}); + }); + } + + return 1; } # Parse: Numeric:465 # You're banned creep! sub num465 { -ssssmy ($svr, undef) = @_; -ssss -sssserr(3, "Banned from ".$svr."! Closing link...", 0); -ssss -ssssreturn 1; + my ($svr, undef) = @_; + + err(3, "Banned from ".$svr."! Closing link...", 0); + + return 1; } # Parse: Numeric:471 # Cannot join channel: Channel is full. sub num471 { -ssssmy ($svr, (undef, undef, undef, $chan)) = @_; -ssss -sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Channel is full.", 0); -ssss -ssssreturn 1; + my ($svr, (undef, undef, undef, $chan)) = @_; + + err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is full.", 0); + + return 1; } # Parse: Numeric:473 # Cannot join channel: Channel is invite-only. sub num473 { -ssssmy ($svr, (undef, undef, undef, $chan)) = @_; -ssss -sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Channel is invite-only.", 0); -ssss -ssssreturn 1; + my ($svr, (undef, undef, undef, $chan)) = @_; + + err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is invite-only.", 0); + + return 1; } # Parse: Numeric:474 # Cannot join channel: Banned from channel. sub num474 { -ssssmy ($svr, (undef, undef, undef, $chan)) = @_; -ssss -sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0); -ssss -ssssreturn 1; + my ($svr, (undef, undef, undef, $chan)) = @_; + + err(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0); + + return 1; } # Parse: Numeric:475 # Cannot join channel: Bad key. sub num475 { -ssssmy ($svr, (undef, undef, undef, $chan)) = @_; -ssss -sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0); -ssss -ssssreturn 1; + my ($svr, (undef, undef, undef, $chan)) = @_; + + err(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0); + + return 1; } # Parse: Numeric:477 # Cannot join channel: Need registered nickname. sub num477 { -ssssmy ($svr, (undef, undef, undef, $chan)) = @_; -ssss -sssserr(3, "Cannot join channel ".$chan." on ".$svr.": Need registered nickname.", 0); -ssss -ssssreturn 1; + my ($svr, (undef, undef, undef, $chan)) = @_; + + err(3, "Cannot join channel ".$chan." on ".$svr.": Need registered nickname.", 0); + + return 1; } # Parse: JOIN sub cjoin { -ssssmy ($svr, @ex) = @_; -ssssmy %src = API::IRC::usrc(substr($ex[0], 1)); + my ($svr, @ex) = @_; + my %src = API::IRC::usrc(substr($ex[0], 1)); my $chan = $ex[2]; $chan =~ s/^://gxsm; -ssss -ssss# Check if this is coming from ourselves. -ssssif ($src{nick} eq $botnick{$svr}{nick}) { -ssss $botchans{$svr}{lc $chan} = 1; -ssss API::Std::event_run("on_ucjoin", ($svr, $chan)); -ssss} -sssselse { -ssss # It isn't. Update chanusers and trigger on_rcjoin. + + # Check if this is coming from ourselves. + if ($src{nick} eq $botnick{$svr}{nick}) { + $botchans{$svr}{lc $chan} = 1; + API::Std::event_run("on_ucjoin", ($svr, $chan)); + } + else { + # It isn't. Update chanusers and trigger on_rcjoin. $chanusers{$svr}{lc $chan}{$src{nick}} = 1; $src{svr} = $svr; -ssss API::Std::event_run("on_rcjoin", (\%src, $chan)); -ssss} -ssss -ssssreturn 1; + API::Std::event_run("on_rcjoin", (\%src, $chan)); + } + + return 1; } # Parse: KICK @@ -454,35 +454,35 @@ sub mode # Parse: NICK sub nick { -ssssmy ($svr, ($uex, undef, $nex)) = @_; + my ($svr, ($uex, undef, $nex)) = @_; $nex = substr($nex, 1); -ssssmy %src = API::IRC::usrc(substr($uex, 1)); -ssss -ssss# Check if this is coming from ourselves. -ssssif ($src{nick} eq $botnick{$svr}{nick}) { -ssss # It is. Update bot nick hash. -ssss $botnick{$svr}{nick} = $nex; -ssss delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick}); -ssss} -sssselse { -ssss # It isn't. Update chanusers and trigger on_nick. + my %src = API::IRC::usrc(substr($uex, 1)); + + # Check if this is coming from ourselves. + if ($src{nick} eq $botnick{$svr}{nick}) { + # It is. Update bot nick hash. + $botnick{$svr}{nick} = $nex; + delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick}); + } + else { + # It isn't. Update chanusers and trigger on_nick. foreach my $chk (keys %{ $chanusers{$svr} }) { if (defined $chanusers{$svr}{$chk}{$src{nick}}) { $chanusers{$svr}{$chk}{$nex} = $chanusers{$svr}{$chk}{$src{nick}}; delete $chanusers{$svr}{$chk}{$src{nick}}; } } -ssss API::Std::event_run("on_nick", ($svr, \%src, $nex)); -ssss} -ssss -ssssreturn 1; + API::Std::event_run("on_nick", ($svr, \%src, $nex)); + } + + return 1; } # Parse: NOTICE sub notice { -ssssmy ($svr, @ex) = @_; + my ($svr, @ex) = @_; # Ensure this is coming from a user rather than a server. if ($ex[0] !~ m/!/xsm) { return; } @@ -493,11 +493,11 @@ ssssmy ($svr, @ex) = @_; shift @ex; shift @ex; shift @ex; $ex[0] = substr $ex[0], 1; $src{svr} = $svr; -ssss + # Send it off. -ssssAPI::Std::event_run("on_notice", (\%src, $target, @ex)); -ssss -ssssreturn 1; + API::Std::event_run("on_notice", (\%src, $target, @ex)); + + return 1; } # Parse: PART @@ -529,33 +529,33 @@ sub part # Parse: PRIVMSG sub privmsg { -ssssmy ($svr, @ex) = @_; + my ($svr, @ex) = @_; my %data = API::IRC::usrc(substr($ex[0], 1)); # Ensure this is coming from a user rather than a server. if ($ex[0] !~ m/!/xsm) { return; } my @argv; -ssssfor (my $i = 4; $i < scalar(@ex); $i++) { -ssss push(@argv, $ex[$i]); -ssss} -ssss$data{svr} = $svr; -ssss -ssssmy ($cmd, $cprefix, $rprefix); -ssss# Check if it's to a channel or to us. -ssssif (lc($ex[2]) eq lc($botnick{$svr}{nick})) { -ssss # It is coming to us in a private message. + for (my $i = 4; $i < scalar(@ex); $i++) { + push(@argv, $ex[$i]); + } + $data{svr} = $svr; + + my ($cmd, $cprefix, $rprefix); + # Check if it's to a channel or to us. + if (lc($ex[2]) eq lc($botnick{$svr}{nick})) { + # It is coming to us in a private message. # Ensure it's a valid length. if (length($ex[3]) > 1) { -ssss $cmd = uc(substr($ex[3], 1)); -ssss if (defined $API::Std::CMDS{$cmd}) { + $cmd = uc(substr($ex[3], 1)); + if (defined $API::Std::CMDS{$cmd}) { # If this is indeed a command, continue. -ssss if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) { + if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) { # Ensure the level is private or all. if (API::Std::ratelimit_check(%data)) { # Continue if the user has not passed the ratelimit amount. -ssss if ($API::Std::CMDS{$cmd}{priv}) { + if ($API::Std::CMDS{$cmd}{priv}) { # If this command requires a privilege... if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) { # Make sure they have it. @@ -575,26 +575,26 @@ ssss if ($API::Std::CMDS{$cmd}{priv}) { # Send them a notice about their bad deed. API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.}); } -ssss } -ssss } + } + } } -ssss # Trigger event on_uprivmsg. + # Trigger event on_uprivmsg. shift @ex; shift @ex; shift @ex; $ex[0] = substr $ex[0], 1; -ssss API::Std::event_run("on_uprivmsg", (\%data, @ex)); -ssss} -sssselse { -ssss # It is coming to us in a channel message. -ssss $data{chan} = $ex[2]; + API::Std::event_run("on_uprivmsg", (\%data, @ex)); + } + else { + # It is coming to us in a channel message. + $data{chan} = $ex[2]; # Ensure it's a valid length before continuing. -ssss if (length($ex[3]) > 1) { + if (length($ex[3]) > 1) { $cprefix = (conf_get("fantasy_pf"))[0][0]; -ssss $rprefix = substr($ex[3], 1, 1); -ssss $cmd = uc(substr($ex[3], 2)); -ssss if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) { + $rprefix = substr($ex[3], 1, 1); + $cmd = uc(substr($ex[3], 2)); + if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) { # If this is indeed a command, continue. -ssss if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) { + if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) { # Ensure the level is public or all. if (API::Std::ratelimit_check(%data)) { # Continue if the user has not passed the ratelimit amount. @@ -641,24 +641,24 @@ ssss if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2 } } } -ssss } + } } -ssss # Trigger event on_cprivmsg. + # Trigger event on_cprivmsg. my $target = $ex[2]; delete $data{chan}; shift @ex; shift @ex; shift @ex; $ex[0] = substr $ex[0], 1; -ssss API::Std::event_run("on_cprivmsg", (\%data, $target, @ex)); -ssss} -ssss -ssssreturn 1; + API::Std::event_run("on_cprivmsg", (\%data, $target, @ex)); + } + + return 1; } # Parse: QUIT sub quit { my ($svr, @ex) = @_; -ssssmy %src = API::IRC::usrc(substr($ex[0], 1)); + my %src = API::IRC::usrc(substr($ex[0], 1)); # Set $msg to the quit message. my $msg = 0; @@ -680,23 +680,23 @@ ssssmy %src = API::IRC::usrc(substr($ex[0], 1)); # Parse: TOPIC sub topic { -ssssmy ($svr, @ex) = @_; -ssssmy %src = API::IRC::usrc(substr($ex[0], 1)); -ssss -ssss# Ignore it if it's coming from us. -ssssif (lc($src{nick}) ne lc($botnick{$svr}{nick})) { -ssss $src{chan} = $ex[2]; -ssss my (@argv); -ssss $argv[0] = substr($ex[3], 1); -ssss if (defined $ex[4]) { -ssss for (my $i = 4; $i < scalar(@ex); $i++) { -ssss push(@argv, $ex[$i]); -ssss } -ssss } -ssss API::Std::event_run("on_topic", ($svr, \%src, @argv)); -ssss} -ssss -ssssreturn 1; + my ($svr, @ex) = @_; + my %src = API::IRC::usrc(substr($ex[0], 1)); + + # Ignore it if it's coming from us. + if (lc($src{nick}) ne lc($botnick{$svr}{nick})) { + $src{chan} = $ex[2]; + my (@argv); + $argv[0] = substr($ex[3], 1); + if (defined $ex[4]) { + for (my $i = 4; $i < scalar(@ex); $i++) { + push(@argv, $ex[$i]); + } + } + API::Std::event_run("on_topic", ($svr, \%src, @argv)); + } + + return 1; } diff --git a/lib/Parser/Lang.pm b/lib/Parser/Lang.pm index 1131598..a31b21c 100644 --- a/lib/Parser/Lang.pm +++ b/lib/Parser/Lang.pm @@ -10,56 +10,56 @@ use API::Log qw(dbug alog); # Parser. sub parse { -ssssmy ($lang) = @_; -ssss -ssss# Check that the language file exists. -ssssunless (-e "$Auto::Bin/../lang/$lang.alf") { -ssss # Otherwise, use English. -ssss dbug "Language '$lang' not found. Using English."; -ssss alog "Language '$lang' not found. Using English."; -ssss $lang = "en"; -ssss} -ssss -ssss# Open, read and close the file. -ssssopen(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0; -ssssmy @fbuf = <$FALF>; -ssssclose $FALF; -ssss -ssss# Iterate the file buffer. -ssssforeach my $buff (@fbuf) { -ssss if (defined $buff) { -ssss # Space buffer. -ssss my @sbuf = split(' ', $buff); -ssss -ssss # Check for all required values. -ssss if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) { -ssss # Missing a value. -ssss next; -ssss } -ssss -ssss # Make sure the first value is "msge". -ssss if ($sbuf[0] ne "msge") { -ssss # It isn't. -ssss next; -ssss } -ssss -ssss my $id = $sbuf[1]; -ssss my $val = $sbuf[2]; -ssss -ssss # If the translation is multi-word, continue to parse. -ssss if (defined $sbuf[3]) { -ssss for (my $i = 3; $i < scalar(@sbuf); $i++) { -ssss $val .= " ".$sbuf[$i]; -ssss } -ssss } -ssss -ssss # Save to memory. -ssss $id =~ s/"//g; -ssss $val =~ s/"//g; -ssss $API::Std::LANGE{$id} = $val; -ssss } -ssss} -ssssreturn 1; + my ($lang) = @_; + + # Check that the language file exists. + unless (-e "$Auto::Bin/../lang/$lang.alf") { + # Otherwise, use English. + dbug "Language '$lang' not found. Using English."; + alog "Language '$lang' not found. Using English."; + $lang = "en"; + } + + # Open, read and close the file. + open(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0; + my @fbuf = <$FALF>; + close $FALF; + + # Iterate the file buffer. + foreach my $buff (@fbuf) { + if (defined $buff) { + # Space buffer. + my @sbuf = split(' ', $buff); + + # Check for all required values. + if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) { + # Missing a value. + next; + } + + # Make sure the first value is "msge". + if ($sbuf[0] ne "msge") { + # It isn't. + next; + } + + my $id = $sbuf[1]; + my $val = $sbuf[2]; + + # If the translation is multi-word, continue to parse. + if (defined $sbuf[3]) { + for (my $i = 3; $i < scalar(@sbuf); $i++) { + $val .= " ".$sbuf[$i]; + } + } + + # Save to memory. + $id =~ s/"//g; + $val =~ s/"//g; + $API::Std::LANGE{$id} = $val; + } + } + return 1; } diff --git a/modules/Badwords.pm b/modules/Badwords.pm index b4713cd..34134f7 100644 --- a/modules/Badwords.pm +++ b/modules/Badwords.pm @@ -12,12 +12,12 @@ use API::IRC qw(privmsg notice kick ban); sub _init { # Check for required configuration values. -ssssif (!conf_get('badwords')) { -ssss err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0); -ssss return; -ssss} + if (!conf_get('badwords')) { + err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0); + return; + } # Create the act_on_badword hook. -sssshook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return; + hook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return; # Success. return 1; @@ -27,16 +27,16 @@ sssshook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or re sub _void { # Delete the act_on_badword hook. -sssshook_del('act_on_badword') or return 0; + hook_del('act_on_badword') or return 0; # Success. -ssssreturn 1; + return 1; } # Callback for act_on_badword hook. sub actonbadword { -ssssmy (($src, $chan, @msg)) = @_; + my (($src, $chan, @msg)) = @_; my $msg = join ' ', @msg; diff --git a/modules/Bitly.pm b/modules/Bitly.pm index 5757a38..4c160fe 100644 --- a/modules/Bitly.pm +++ b/modules/Bitly.pm @@ -13,13 +13,13 @@ use URI::Escape; sub _init { # Check for required configuration values. -ssssif (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) { -ssss err(2, "Please verify that you have bitly_user and bitly_key defined in your configuration file.", 0); -ssss return 0; -ssss} + if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) { + err(2, "Please verify that you have bitly_user and bitly_key defined in your configuration file.", 0); + return 0; + } # Create the SHORTEN and REVERSE commands. -sssscmd_add("SHORTEN", 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return 0; -sssscmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return 0; + cmd_add("SHORTEN", 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return 0; + cmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return 0; # Success. return 1; @@ -29,11 +29,11 @@ sssscmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or r sub _void { # Delete the SHORTEN and REVERSE commands. -sssscmd_del("SHORTEN") or return 0; -sssscmd_del("REVERSE") or return 0; + cmd_del("SHORTEN") or return 0; + cmd_del("REVERSE") or return 0; # Success. -ssssreturn 1; + return 1; } # Help hashes. @@ -47,37 +47,37 @@ our %HELP_REVERSE = ( # Callback for SHORTEN command. sub shorten { -ssssmy ($src, @args) = @_; + my ($src, @args) = @_; # Create an instance of LWP::UserAgent. -ssssmy $ua = LWP::UserAgent->new(); -ssss$ua->agent('Auto IRC Bot'); -ssss$ua->timeout(2); + my $ua = LWP::UserAgent->new(); + $ua->agent('Auto IRC Bot'); + $ua->timeout(2); # Put together the call to the Bit.ly API. if (!defined $args[0]) { notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); return 0; } -ssssmy ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]); + my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]); $surl = uri_escape($surl); -ssssmy $url = "http://api.bit.ly/v3/shorten?version=3.0.1&longUrl=".$surl."&apiKey=".$key."&login=".$user."&format=txt"; + my $url = "http://api.bit.ly/v3/shorten?version=3.0.1&longUrl=".$surl."&apiKey=".$key."&login=".$user."&format=txt"; # Get the response via HTTP. my $response = $ua->get($url); -ssssif ($response->is_success) { + if ($response->is_success) { # If successful, decode the content. my $d = $response->decoded_content; -ssss chomp $d; + chomp $d; # And send to channel. -ssss privmsg($src->{svr}, $src->{chan}, "URL: ".$d); -ssss} + privmsg($src->{svr}, $src->{chan}, "URL: ".$d); + } else { # Otherwise, send an error message. privmsg($src->{svr}, $src->{chan}, "An error occurred while shortening your URL."); } -ssssreturn 1; + return 1; } # Callback for REVERSE command. @@ -104,16 +104,16 @@ sub reverse if ($response->is_success) { # If successful, decode the content. my $d = $response->decoded_content; -ssss chomp $d; + chomp $d; # And send it to channel. -ssss privmsg($src->{svr}, $src->{chan}, "URL: ".$d); -ssss} -sssselse { + privmsg($src->{svr}, $src->{chan}, "URL: ".$d); + } + else { # Otherwise, send an error message. -ssss privmsg($src->{svr}, $src->{chan}, "An error occurred while reversing your URL."); -ssss} + privmsg($src->{svr}, $src->{chan}, "An error occurred while reversing your URL."); + } -ssssreturn 1; + return 1; } diff --git a/modules/Calc.pm b/modules/Calc.pm index 19fe3ee..f9247dc 100644 --- a/modules/Calc.pm +++ b/modules/Calc.pm @@ -13,68 +13,68 @@ use JSON -support_by_pp; # Initialization subroutine. sub _init { -ssss# Create the CALC command. -sssscmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return 0; + # Create the CALC command. + cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return 0; -ssss# Success. -ssssreturn 1; + # Success. + return 1; } # Void subroutine. sub _void { -ssss# Delete the CALC command. -sssscmd_del("CALC") or return 0; + # Delete the CALC command. + cmd_del("CALC") or return 0; -ssss# Success. -ssssreturn 1; + # Success. + return 1; } # Help hash. our %FHELP_CALC = ( -ssss'en' => "This command will calculate an expression using Google Calculator. \002Syntax:\002 CALC ", + 'en' => "This command will calculate an expression using Google Calculator. \002Syntax:\002 CALC ", ); # Callback for CALC command. sub calc { -ssssmy ($src, @args) = @_; + my ($src, @args) = @_; -ssss# Create an instance of LWP::UserAgent. -ssssmy $ua = LWP::UserAgent->new(); -ssss$ua->agent('Auto IRC Bot'); -ssss$ua->timeout(2); -ssss# Create an instance of JSON. -ssssmy $json = JSON->new(); -ssss# Put together the call to the Google Calculator API. + # Create an instance of LWP::UserAgent. + my $ua = LWP::UserAgent->new(); + $ua->agent('Auto IRC Bot'); + $ua->timeout(2); + # Create an instance of JSON. + my $json = JSON->new(); + # Put together the call to the Google Calculator API. if (!defined $args[0]) { notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); return 0; } my $expr = join(' ', @args); -ssssmy $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr); -ssss# Get the response via HTTP. -ssssmy $response = $ua->get($url); + my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr); + # Get the response via HTTP. + my $response = $ua->get($url); -ssssif ($response->is_success) { -ssss # If successful, decode the content. -ssss my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content); + if ($response->is_success) { + # If successful, decode the content. + my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content); -ssss if ($d->{error} eq "" or $d->{error} == 0) { -ssss # And send to channel + if ($d->{error} eq "" or $d->{error} == 0) { + # And send to channel privmsg($src->{svr}, $src->{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs}); -ssss } -ssss else { -ssss # Otherwise, send an error message. -ssss privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error."); -ssss } -ssss} -sssselse { -ssss # Otherwise, send an error message. -ssss privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator."); -ssss} + } + else { + # Otherwise, send an error message. + privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error."); + } + } + else { + # Otherwise, send an error message. + privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator."); + } -ssssreturn 1; + return 1; } # Start initialization. diff --git a/modules/EightBall.pm b/modules/EightBall.pm index 8d88e27..eaaf8f1 100644 --- a/modules/EightBall.pm +++ b/modules/EightBall.pm @@ -13,8 +13,8 @@ our $ANSWER = 0; sub _init { # Create the 8BALL and RIGBALL commands. -sssscmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return 0; -sssscmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return 0; + cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return 0; + cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return 0; # Success. return 1; @@ -24,11 +24,11 @@ sssscmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::Eigh sub _void { # Delete the 8BALL and RIGBALL commands. -sssscmd_del('8BALL') or return 0; -sssscmd_del('RIGBALL') or return 0; + cmd_del('8BALL') or return 0; + cmd_del('RIGBALL') or return 0; # Success. -ssssreturn 1; + return 1; } # Help hashes. @@ -42,7 +42,7 @@ our %HELP_RIGBALL = ( # Callback for 8BALL command. sub c_8ball { -ssssmy ($src, @argv) = @_; + my ($src, @argv) = @_; if (!defined $argv[0]) { notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); @@ -77,7 +77,7 @@ ssssmy ($src, @argv) = @_; privmsg($src->{svr}, $src->{chan}, "\002Answer:\002 ".$a); -ssssreturn 1; + return 1; } # Callback for RIGBALL command. @@ -94,7 +94,7 @@ sub rigball $ANSWER = join(" ", @argv); privmsg($src->{svr}, $src->{nick}, "Answer set to: ".$ANSWER); -ssssreturn 1; + return 1; } diff --git a/modules/FML.pm b/modules/FML.pm index 43dbec4..0131984 100644 --- a/modules/FML.pm +++ b/modules/FML.pm @@ -12,7 +12,7 @@ use LWP::UserAgent; sub _init { # Create the FML command. -sssscmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0; + cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0; # Success. return 1; @@ -22,10 +22,10 @@ sssscmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0; sub _void { # Delete the FML command. -sssscmd_del('FML') or return 0; + cmd_del('FML') or return 0; # Success. -ssssreturn 1; + return 1; } # Help hash. @@ -36,34 +36,34 @@ our %HELP_FML = ( # Callback for FML command. sub fml { -ssssmy ($src, undef) = @_; + my ($src, undef) = @_; # Create an instance of LWP::UserAgent. -ssssmy $ua = LWP::UserAgent->new(); -ssss$ua->agent('Auto IRC Bot'); -ssss$ua->timeout(2); + my $ua = LWP::UserAgent->new(); + $ua->agent('Auto IRC Bot'); + $ua->timeout(2); # Get the random FML via HTTP. my $rp = $ua->get('http://rscript.org/lookup.php?type=fml'); -ssssif ($rp->is_success) { + if ($rp->is_success) { # If successful, decode the content. my $d = $rp->decoded_content; -ssss $d =~ s/(\n|\r)//g; + $d =~ s/(\n|\r)//g; # Get the FML. my (undef, $dfa) = split('Text: ', $d); my ($fml, undef) = split('Agree:', $dfa); # And send to channel. -ssss privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml); -ssss} + privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml); + } else { # Otherwise, send an error message. privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving the FML."); } -ssssreturn 1; + return 1; } # Start initialization. diff --git a/modules/HelloChan.pm b/modules/HelloChan.pm index 5d310ae..b02b023 100644 --- a/modules/HelloChan.pm +++ b/modules/HelloChan.pm @@ -10,28 +10,28 @@ use API::IRC qw(privmsg); # Initialization subroutine. sub _init { -ssss# Add a hook for when we join a channel. -sssshook_add("on_ucjoin", "HelloChan", \&M::HelloChan::hello) or return 0; -ssssreturn 1; + # Add a hook for when we join a channel. + hook_add("on_ucjoin", "HelloChan", \&M::HelloChan::hello) or return 0; + return 1; } # Void subroutine. sub _void { -ssss# Delete the hook. -sssshook_del("on_ucjoin", "HelloChan") or return 0; -ssssreturn 1; + # Delete the hook. + hook_del("on_ucjoin", "HelloChan") or return 0; + return 1; } # Main subroutine. sub hello { -ssssmy (($svr, $chan)) = @_; -ssss -ssss# Send a PRIVMSG. -ssssprivmsg($svr, $chan, "Hello channel! I am a bot!"); -ssss -ssssreturn 1; + my (($svr, $chan)) = @_; + + # Send a PRIVMSG. + privmsg($svr, $chan, "Hello channel! I am a bot!"); + + return 1; } diff --git a/modules/IsItUp.pm b/modules/IsItUp.pm index d2d5d72..67c07ad 100644 --- a/modules/IsItUp.pm +++ b/modules/IsItUp.pm @@ -11,61 +11,61 @@ use LWP::UserAgent; # Initialization subroutine. sub _init { -ssss# Create the ISITUP command. -sssscmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return 0; + # Create the ISITUP command. + cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return 0; -ssss# Success. -ssssreturn 1; + # Success. + return 1; } # Void subroutine. sub _void { -ssss# Delete the ISITUP command. -sssscmd_del('ISITUP') or return 0; + # Delete the ISITUP command. + cmd_del('ISITUP') or return 0; -ssss# Success. -ssssreturn 1; + # Success. + return 1; } # Help hashes. our %HELP_ISITUP = ( -ssss'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP ", + 'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP ", ); # Callback for ISITUP command. sub check { -ssssmy ($src, @argv) = @_; + my ($src, @argv) = @_; -ssss# Create an instance of LWP::UserAgent. -ssssmy $ua = LWP::UserAgent->new(); -ssss$ua->agent('Auto IRC Bot'); -ssss$ua->timeout(2); -ssss# Do we have enough parameters? -ssssif (!defined $argv[0]) { -ssss notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.}); -ssss return 0; -ssss} -ssssmy $curl = $argv[0]; -ssss# Does the URL start with http(s)? -ssssif ($curl !~ m/^http/) { -ssss $curl = 'http://'.$curl; -ssss} + # Create an instance of LWP::UserAgent. + my $ua = LWP::UserAgent->new(); + $ua->agent('Auto IRC Bot'); + $ua->timeout(2); + # Do we have enough parameters? + if (!defined $argv[0]) { + notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.}); + return 0; + } + my $curl = $argv[0]; + # Does the URL start with http(s)? + if ($curl !~ m/^http/) { + $curl = 'http://'.$curl; + } -ssss# Get the response via HTTP. -ssssmy $response = $ua->get($curl); + # Get the response via HTTP. + my $response = $ua->get($curl); -ssssif ($response->is_success) { -ssss # If successful, it's up. -ssss privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.'); -ssss} -sssselse { -ssss # Otherwise, it's down. -ssss privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.'); -ssss} + if ($response->is_success) { + # If successful, it's up. + privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.'); + } + else { + # Otherwise, it's down. + privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.'); + } -ssssreturn 1; + return 1; } # Start initialization. diff --git a/modules/SASLAuth.pm b/modules/SASLAuth.pm index 7630f79..f4ad9a5 100644 --- a/modules/SASLAuth.pm +++ b/modules/SASLAuth.pm @@ -13,9 +13,9 @@ use API::IRC qw(privmsg); # Initialization subroutine. sub _init { -ssss# Check if this Auto was built with SASL support. -sssserr(2, "Auto was not built with SASL support. Aborting SASLAuth.", 0) and return 0 if $Auto::ENFEAT !~ /sasl/; -ssss# Add a hook for before we connect. + # Check if this Auto was built with SASL support. + err(2, "Auto was not built with SASL support. Aborting SASLAuth.", 0) and return 0 if $Auto::ENFEAT !~ /sasl/; + # Add a hook for before we connect. hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); } ) or return 0; # Hook for parsing CAP. @@ -26,19 +26,19 @@ ssss# Add a hook for before we connect. rchook_add('904', \&M::SASLAuth::handle_904) or return 0; # Hook for parsing 906. rchook_add('906', \&M::SASLAuth::handle_906) or return 0; -ssssreturn 1; + return 1; } # Void subroutine. sub _void { -ssss# Delete the hooks. -sssshook_del("on_preconnect", "CAP") or return 0; + # Delete the hooks. + hook_del("on_preconnect", "CAP") or return 0; rchook_del('CAP'); rchook_del('903'); rchook_del('904'); rchook_del('906'); -ssssreturn 1; + return 1; } sub handle_cap { @@ -123,8 +123,8 @@ sub handle_904 # SASL authentication aborted. sub handle_906 { -ssssmy ($svr, undef) = @_; -ssssAuto::socksnd($svr, 'CAP END'); + my ($svr, undef) = @_; + Auto::socksnd($svr, 'CAP END'); timer_del('auth_timeout'); awarn(2, "SASL authentication aborted!"); } diff --git a/modules/Weather.pm b/modules/Weather.pm index 03e9833..0f3180b 100644 --- a/modules/Weather.pm +++ b/modules/Weather.pm @@ -12,69 +12,69 @@ use XML::Simple; # Initialization subroutine. sub _init { -ssss# Create the Weather command. -sssscmd_add("WEATHER", 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return 0; + # Create the Weather command. + cmd_add("WEATHER", 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return 0; -ssss# Success. -ssssreturn 1; + # Success. + return 1; } # Void subroutine. sub _void { -ssss# Delete the Weather command. -sssscmd_del("WEATHER") or return 0; + # Delete the Weather command. + cmd_del("WEATHER") or return 0; -ssss# Success. -ssssreturn 1; + # Success. + return 1; } # Help hashes. our %HELP_WEATHER = ( -ssss'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER ", + 'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER ", ); # Callback for Weather command. sub weather { -ssssmy ($src, @args) = @_; + my ($src, @args) = @_; -ssss# Create an instance of LWP::UserAgent. -ssssmy $ua = LWP::UserAgent->new(); -ssss$ua->agent('Auto IRC Bot'); -ssss$ua->timeout(2); -ssss# Put together the call to the Wunderground API. -ssssif (!defined $args[0]) { -ssss notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); -ssss return 0; -ssss} -ssssmy $loc = join(' ', @args); -ssss$loc =~ s/ /%20/g; -ssssmy $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=".$loc; -ssss# Get the response via HTTP. -ssssmy $response = $ua->get($url); + # Create an instance of LWP::UserAgent. + my $ua = LWP::UserAgent->new(); + $ua->agent('Auto IRC Bot'); + $ua->timeout(2); + # Put together the call to the Wunderground API. + if (!defined $args[0]) { + notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); + return 0; + } + my $loc = join(' ', @args); + $loc =~ s/ /%20/g; + my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=".$loc; + # Get the response via HTTP. + my $response = $ua->get($url); -ssssif ($response->is_success) { -ssss# If successful, decode the content. -ssss my $d = XMLin($response->decoded_content); -ssss# And send to channel -ssss if (!ref($d->{observation_location}->{country})) { -ssss my $windc = $d->{wind_string}; -ssss if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); } -ssss privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather}); -ssss privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time}); -ssss } -ssss else { -ssss # Otherwise, send an error message. -ssss privmsg($src->{svr}, $src->{chan}, "Location not found."); -ssss } -ssss} -sssselse { -ssss# Otherwise, send an error message. -ssss privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving your weather."); -ssss} + if ($response->is_success) { + # If successful, decode the content. + my $d = XMLin($response->decoded_content); + # And send to channel + if (!ref($d->{observation_location}->{country})) { + my $windc = $d->{wind_string}; + if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); } + privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather}); + privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time}); + } + else { + # Otherwise, send an error message. + privmsg($src->{svr}, $src->{chan}, "Location not found."); + } + } + else { + # Otherwise, send an error message. + privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving your weather."); + } -ssssreturn 1; + return 1; } # Start initialization. diff --git a/rmtabs b/rmtabs deleted file mode 100755 index 6fc1f1a..0000000 --- a/rmtabs +++ /dev/null @@ -1,2 +0,0 @@ -#!/usr/bin/perl -pi -s/\t/\s\s\s\s/;