More cleanup.

This commit is contained in:
Elijah Perrault committed 2011-02-06 22:17:40 -07:00
1 parent f60a42f28a
commit 20653aba80
1 file changed
+49 -48
+49 -48
View File
@@ -9,6 +9,7 @@ use strict;
use warnings; use warnings;
use POSIX; use POSIX;
use locale; use locale;
use English qw(-no_match_vars);
use feature qw(switch); use feature qw(switch);
use Mouse; use Mouse;
use IO::Socket; use IO::Socket;
@@ -17,7 +18,7 @@ use Class::Unload;
use FindBin qw($Bin); use FindBin qw($Bin);
our $Bin = $Bin; our $Bin = $Bin;
BEGIN { BEGIN {
unshift(@INC, "$Bin/../src"); unshift(@INC, "$Bin/../src");
# Set version information. # Set version information.
use constant { use constant {
@@ -39,7 +40,7 @@ use Core::IRC;
our $VERSION = 3.0.0; our $VERSION = 3.0.0;
local $0 = 'auto'; local $PROGRAM_NAME = 'auto';
# Check for build files. # Check for build files.
if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") { if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") {
@@ -49,8 +50,8 @@ if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/tim
# Check build OS. # Check build OS.
open(my $BFOS, '<', "$Bin/../build/os") or println 'Cannot start: Broken build.' and exit; open(my $BFOS, '<', "$Bin/../build/os") or println 'Cannot start: Broken build.' and exit;
my @BFOS = <$BFOS>; my @BFOS = <$BFOS>;
close $BFOS; close $BFOS or println 'Cannot start: Broken build.' and exit;
if ($BFOS[0] ne $^O."\n") { if ($BFOS[0] ne $OSNAME."\n") {
println 'Cannot start: Broken build.' and exit; println 'Cannot start: Broken build.' and exit;
} }
undef @BFOS; undef @BFOS;
@@ -59,14 +60,14 @@ undef @BFOS;
our $ENFEAT; our $ENFEAT;
open(my $BFFEAT, '<', "$Bin/../build/feat") or println 'Cannot start: Broken build.' and exit; open(my $BFFEAT, '<', "$Bin/../build/feat") or println 'Cannot start: Broken build.' and exit;
my @BFFEAT = <$BFFEAT>; my @BFFEAT = <$BFFEAT>;
close $BFFEAT; close $BFFEAT or println 'Cannot start: Broken build.' and exit;
$ENFEAT = substr($BFFEAT[0], 0, length($BFFEAT[0]) - 1); $ENFEAT = substr($BFFEAT[0], 0, length($BFFEAT[0]) - 1);
undef @BFFEAT; undef @BFFEAT;
# Check build Perl version. # Check build Perl version.
open(my $BFPERL, '<', "$Bin/../build/perl") or println 'Cannot start: Broken build.' and exit; open(my $BFPERL, '<', "$Bin/../build/perl") or println 'Cannot start: Broken build.' and exit;
my @BFPERL = <$BFPERL>; my @BFPERL = <$BFPERL>;
close $BFPERL; close $BFPERL or println 'Cannot start: Broken build.' and exit;
if ($BFPERL[0] ne $]."\n") { if ($BFPERL[0] ne $]."\n") {
println 'Cannot start: Broken build.' and exit; println 'Cannot start: Broken build.' and exit;
} }
@@ -75,8 +76,8 @@ undef @BFPERL;
# Check build Auto version. # Check build Auto version.
open(my $BFVER, '<', "$Bin/../build/ver") or println 'Cannot start: Broken build.' and exit; open(my $BFVER, '<', "$Bin/../build/ver") or println 'Cannot start: Broken build.' and exit;
my @BFVER = <$BFVER>; my @BFVER = <$BFVER>;
close $BFVER; close $BFVER or println 'Cannot start: Broken build.' and exit;
if ($BFVER[0] ne VER.".".SVER.".".REV.RSTAGE."\n") { if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
println 'Cannot start: Broken build.' and exit; println 'Cannot start: Broken build.' and exit;
} }
undef @BFVER; undef @BFVER;
@@ -101,7 +102,7 @@ println <<'EOF';
88 8 88 8 88 8 8 88 8 88 8 88 8 8
88 8 88ee8 88 8eee8 88 8 88ee8 88 8eee8
EOF EOF
println '* '.NAME.' (version '.VER.'.'.SVER.'.'.REV.RSTAGE.') is starting up...'; println '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
our ($APID, %TIMERS); our ($APID, %TIMERS);
@@ -127,17 +128,17 @@ if (!$NUC and RSTAGE ne 'd') {
'Timeout' => 30 'Timeout' => 30
) or err(1, 'Cannot connect to update server! Aborting update check.'); ) or err(1, 'Cannot connect to update server! Aborting update check.');
send($uss, "GET http://dist.xelhua.org/auto/version.txt\n", 0); send($uss, "GET http://dist.xelhua.org/auto/version.txt\n", 0);
my $dll = ''; my $dll = q{};
while (my $data = readline($uss)) { while (my $data = readline($uss)) {
$data =~ s/(\n|\r)//g; $data =~ s/(\n|\r)//g;
my ($v, $c) = split('=', $data); my ($v, $c) = split(m/[=]/, $data);
if ($v eq 'url') { if ($v eq 'url') {
$dll = $c; $dll = $c;
} }
elsif ($v eq 'version') { elsif ($v eq 'version') {
if (VER.'.'.SVER.'.'.REV.RSTAGE ne $c) { if (VER.q{.}.SVER.q{.}.REV.RSTAGE ne $c) {
println('!!! NOTICE !!! Your copy of Auto is outdated. Current version: '.VER.'.'.SVER.'.'.REV.RSTAGE.' - Latest version: '.$c); println('!!! NOTICE !!! Your copy of Auto is outdated. Current version: '.VER.q{.}.SVER.q{.}.REV.RSTAGE.' - Latest version: '.$c);
println('!!! NOTICE !!! You can get the latest Auto by downloading '.$dll); println('!!! NOTICE !!! You can get the latest Auto by downloading '.$dll);
} }
else { else {
@@ -160,7 +161,7 @@ println ' Success';
if (conf_get('die')) { if (conf_get('die')) {
if ((conf_get('die'))[0][0] == 1) { if ((conf_get('die'))[0][0] == 1) {
println "!!! You didn't read the whole config."; println '!!! You didn\'t read the whole config.';
println '!!! Insert new user then try again.'; println '!!! Insert new user then try again.';
exit; exit;
} }
@@ -182,7 +183,7 @@ undef @REQCVALS;
# Parse translations. # Parse translations.
println '* Parsing translation files...'; println '* Parsing translation files...';
our $LOCALE = (conf_get('locale'))[0][0]; our $LOCALE = (conf_get('locale'))[0][0];
my @lang = split('_', $LOCALE); my @lang = split(m/[_]/, $LOCALE);
Parser::Lang::parse($lang[0]) or err(2, 'Failed to parse translation files!', 1); Parser::Lang::parse($lang[0]) or err(2, 'Failed to parse translation files!', 1);
undef @lang; undef @lang;
println ' Success'; println ' Success';
@@ -199,12 +200,12 @@ our (%PRIVILEGES);
if (conf_get('privset')) { if (conf_get('privset')) {
# Get them. # Get them.
my %tcprivs = conf_get('privset'); my %tcprivs = conf_get('privset');
foreach my $tckpriv (keys %tcprivs) { foreach my $tckpriv (keys %tcprivs) {
# For each privset, get the inner values. # For each privset, get the inner values.
my %mcprivs = conf_get("privset:$tckpriv"); my %mcprivs = conf_get("privset:$tckpriv");
# Iterate through them. # Iterate through them.
foreach my $mckpriv (keys %mcprivs) { foreach my $mckpriv (keys %mcprivs) {
# Switch statement for the values. # Switch statement for the values.
given ($mckpriv) { given ($mckpriv) {
@@ -244,19 +245,19 @@ if (conf_get('privset')) {
# Successful startup. # Successful startup.
our $STARTTIME = time; our $STARTTIME = time;
println '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).'.'; println '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.};
alog 'Auto successfully started.'; alog 'Auto successfully started.';
# Fork into the background if not in debug mode. # Fork into the background if not in debug mode.
if (!$DEBUG) { if (!$DEBUG) {
println '*** Becoming a daemon...'; println '*** Becoming a daemon...';
open(STDIN, '<', '/dev/null') or err(2, "Can't read /dev/null: $!", 1); open(STDIN, '<', '/dev/null') or err(2, "Can't read /dev/null: $ERRNO", 1);
open(STDOUT, '>>', '/dev/null') or err(2, "Can't write to /dev/null: $!", 1); open(STDOUT, '>>', '/dev/null') or err(2, "Can't write to /dev/null: $ERRNO", 1);
open(STDERR, '>>', '/dev/null') or err(2, "Can't write to /dev/null: $!", 1); open(STDERR, '>>', '/dev/null') or err(2, "Can't write to /dev/null: $ERRNO", 1);
$APID = fork(); $APID = fork();
if ($APID != 0) { if ($APID != 0) {
alog '* Successfully forked into the background. Process ID: '.$APID; alog '* Successfully forked into the background. Process ID: '.$APID;
unless (-e "$Bin/auto.pid") { if (!-e "$Bin/auto.pid") {
system("touch $Bin/auto.pid"); system("touch $Bin/auto.pid");
} }
open(my $FPID, '>', "$Bin/auto.pid") or exit; open(my $FPID, '>', "$Bin/auto.pid") or exit;
@@ -264,10 +265,10 @@ if (!$DEBUG) {
close $FPID or exit; close $FPID or exit;
exit; exit;
} }
POSIX::setsid() or err(2, "Can't start a new session: $!", 1); POSIX::setsid() or err(2, "Can't start a new session: $ERRNO", 1);
} }
else { else {
$APID = $$; $APID = $PID;
} }
# Events. # Events.
@@ -307,24 +308,24 @@ foreach my $cskey (keys %cservers) {
# Create the socket. # Create the socket.
if ($use6) { if ($use6) {
$SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or $SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].':'.$cservers{$cskey}{'port'}[0].']', 0) and next; # Or error. err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) and next; # Or error.
} }
else { else {
$SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or $SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].':'.$cservers{$cskey}{'port'}[0].']', 0) and next; # Or error. err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) and next; # Or error.
} }
# Send PASS if we have one. # Send PASS if we have one.
if (defined $cservers{$cskey}{'pass'}[0]) { if (defined $cservers{$cskey}{'pass'}[0]) {
socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].':'.$cservers{$cskey}{'port'}[0].']', 0) err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next; and next;
} }
API::Std::event_run('on_preconnect', $cskey); API::Std::event_run('on_preconnect', $cskey);
# Send USER and NICK. # Send USER and NICK.
socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].' * * :'.$cservers{$cskey}{'realname'}[0]) or socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].' * * :'.$cservers{$cskey}{'realname'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].':'.$cservers{$cskey}{'port'}[0].']', 0) err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next; and next;
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]); API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
# Add to select. # Add to select.
@@ -356,7 +357,7 @@ API::Std::cmd_add('RESTART', 2, 'cmd.restart', \%Core::IRC::HELP_RESTART, \&Core
API::Std::cmd_add('HELP', 2, 0, \%Core::IRC::HELP_HELP, \&Core::IRC::cmd_help); API::Std::cmd_add('HELP', 2, 0, \%Core::IRC::HELP_HELP, \&Core::IRC::cmd_help);
# Infinite while loop. # Infinite while loop.
while (1) { while (1) {
# Timer check. # Timer check.
foreach my $tk (keys %TIMERS) { foreach my $tk (keys %TIMERS) {
if ($TIMERS{$tk}{time} <= time) { if ($TIMERS{$tk}{time} <= time) {
@@ -385,7 +386,7 @@ while (1) {
# Read the data. # Read the data.
my $idata; my $idata;
recv($sock, $idata, POSIX::BUFSIZ, 0); recv($sock, $idata, POSIX::BUFSIZ, 0);
# Check for the data. # Check for the data.
if (!defined $idata || length($idata) == 0) { if (!defined $idata || length($idata) == 0) {
# Got EOF, close socket # Got EOF, close socket
@@ -393,18 +394,18 @@ while (1) {
$SELECT->remove($sock); $SELECT->remove($sock);
next; next;
} }
# Read the buffer. # Read the buffer.
my $data .= $idata; my $data .= $idata;
while ($data =~ s/(.*\n)//) { while ($data =~ s/(.*\n)//) {
my $line = $1; my $line = $1;
# Remove the newlines. # Remove the newlines.
chomp $line; chomp $line;
# Debug. # Debug.
dbug $sockid.' >> '.$line; dbug $sockid.' >> '.$line;
# Parse data. # Parse data.
Parser::IRC::ircparse($sockid, $line); Parser::IRC::ircparse($sockid, $line);
} }
} }
@@ -415,11 +416,11 @@ while (1) {
############### ###############
# Send data to socket. # Send data to socket.
sub socksnd sub socksnd
{ {
my ($svr, $data) = @_; my ($svr, $data) = @_;
if (defined $SOCKET{$svr}) { if (defined $SOCKET{$svr}) {
send($SOCKET{$svr}, $data."\n", 0); send($SOCKET{$svr}, $data."\n", 0);
dbug "$svr << $data"; dbug "$svr << $data";
return 1; return 1;
@@ -432,9 +433,9 @@ sub socksnd
# Load a module. # Load a module.
sub mod_load { sub mod_load {
my ($module) = @_; my ($module) = @_;
if (-e "$Bin/../modules/".$module.".pm") { if (-e "$Bin/../modules/$module.pm") {
do "$Bin/../modules/".$module.".pm" and return 1; do "$Bin/../modules/$module.pm" and return 1;
} }
return 0; return 0;
@@ -493,7 +494,7 @@ sub signal_perlwarn
# __DIE__ # __DIE__
sub signal_perldie sub signal_perldie
{ {
return if $^S; return if $EXCEPTIONS_BEING_CAUGHT;
alog 'Perl Fatal: '.$_[0].' -- Terminating program!'; alog 'Perl Fatal: '.$_[0].' -- Terminating program!';
API::IRC::quit($_, 'A fatal error occurred!') foreach (keys %SOCKET); API::IRC::quit($_, 'A fatal error occurred!') foreach (keys %SOCKET);
DB::flush(); DB::flush();