# MISC STRING UTILITY ROUTINES to convert between DarkPlaces and IRC conventions
# convert mIRC color codes to DP color codes
# MISC STRING UTILITY ROUTINES to convert between DarkPlaces and IRC conventions
# convert mIRC color codes to DP color codes
our @color_irc2dp_table = (7, 0, 4, 2, 1, 1, 6, 1, 3, 2, 5, 5, 4, 6, 7, 7);
our @color_dp2irc_table = (-1, 4, 9, 8, 12, 11, 13, -1, -1, -1); # not accurate, but legible
our @color_dp2ansi_table = ("m", "1;31m", "1;32m", "1;33m", "1;34m", "1;36m", "1;35m", "m", "1m", "1m"); # not accurate, but legible
our @color_irc2dp_table = (7, 0, 4, 2, 1, 1, 6, 1, 3, 2, 5, 5, 4, 6, 7, 7);
our @color_dp2irc_table = (-1, 4, 9, 8, 12, 11, 13, -1, -1, -1); # not accurate, but legible
our @color_dp2ansi_table = ("m", "1;31m", "1;32m", "1;33m", "1;34m", "1;36m", "1;35m", "m", "1m", "1m"); # not accurate, but legible
- "\0", '#', '#', '#', '#', '.', '#', '#',
+ '', '#', '#', '#', '#', '.', '#', '#',
'#', 9, 10, '#', ' ', 13, '.', '.',
'[', ']', '0', '1', '2', '3', '4', '5',
'6', '7', '8', '9', '.', '<', '=', '>',
'#', 9, 10, '#', ' ', 13, '.', '.',
'[', ']', '0', '1', '2', '3', '4', '5',
'6', '7', '8', '9', '.', '<', '=', '>',
'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
'x', 'y', 'z', '{', '|', '}', '~', '<'
);
'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
'x', 'y', 'z', '{', '|', '}', '~', '<'
);
}
sub color_dp_transform(&$)
{
my ($block, $message) = @_;
}
sub color_dp_transform(&$)
{
my ($block, $message) = @_;
$message =~ s{(?:(\^\^)|\^x([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])|\^([0-9])|(.))(?=([0-9,]?))}{
defined $1 ? $block->(char => '^', $7) :
defined $2 ? $block->(rgb => [hex $2, hex $3, hex $4], $7) :
$message =~ s{(?:(\^\^)|\^x([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])|\^([0-9])|(.))(?=([0-9,]?))}{
defined $1 ? $block->(char => '^', $7) :
defined $2 ? $block->(rgb => [hex $2, hex $3, hex $4], $7) :
# Connection:
# $conn->sockname() returns a connection type specific representation
# string of the local address, or undef if not applicable.
# Connection:
# $conn->sockname() returns a connection type specific representation
# string of the local address, or undef if not applicable.
# $conn->send("string") sends something over the connection.
# $conn->recv() receives a string from the connection, or returns "" if no
# data is available.
# $conn->send("string") sends something over the connection.
# $conn->recv() receives a string from the connection, or returns "" if no
# data is available.
irc_admin_quote_re => "",
irc_reconnect_delay => 300,
irc_admin_quote_re => "",
irc_reconnect_delay => 300,
my $slots = $store{slots_max} - $store{slots_active};
my $slots_s = ($slots == 1) ? '' : 's';
$slotsstr = " ($slots free slot$slots_s)";
my $slots = $store{slots_max} - $store{slots_active};
my $slots_s = ($slots == 1) ? '' : 's';
$slotsstr = " ($slots free slot$slots_s)";
$channels{irc} = new Channel::Line(new Connection::Socket(tcp => $config{irc_local} => $config{irc_server} => 6667));
$channels{dp} = new Channel::QW(my $dpsock = new Connection::Socket(udp => $config{dp_listen} => $config{dp_server} => 26000), $config{dp_password}, $config{dp_secure}, $config{dp_secure_challengetimeout});
$config{dp_listen} = $dpsock->sockname();
$channels{irc} = new Channel::Line(new Connection::Socket(tcp => $config{irc_local} => $config{irc_server} => 6667));
$channels{dp} = new Channel::QW(my $dpsock = new Connection::Socket(udp => $config{dp_listen} => $config{dp_server} => 26000), $config{dp_password}, $config{dp_secure}, $config{dp_secure_challengetimeout});
$config{dp_listen} = $dpsock->sockname();
print "Listening on $config{dp_listen}\n";
$channels{irc}->throttle(0.5, 5);
print "Listening on $config{dp_listen}\n";
$channels{irc}->throttle(0.5, 5);
- out dp => 0, 'sv_cmd bans', 'status 1', 'log_dest_udp';
+ out dp => 0, 'sv_cmd banlist', 'status 1', 'log_dest_udp';
# if we get here, we are on IRC
$store{irc_joined_channel} = 1;
schedule sub {
# if we get here, we are on IRC
$store{irc_joined_channel} = 1;
schedule sub {
[ dp => q{"log_dest_udp" is "([^"]*)" \["[^"]*"\]} => sub {
my ($dest) = @_;
my @dests = split ' ', $dest;
[ dp => q{"log_dest_udp" is "([^"]*)" \["[^"]*"\]} => sub {
my ($dest) = @_;
my @dests = split ' ', $dest;
- return 0 if grep { $_ eq $config{dp_listen} } @dests;
- out dp => 0, 'log_dest_udp "' . join(" ", @dests, $config{dp_listen}) . '"';
+ return 0 if grep { $_ eq pickip($config{dp_listen_from_server}, $config{dp_listen}) } @dests;
+ out dp => 0, 'log_dest_udp "' . join(" ", @dests, pickip($config{dp_listen_from_server}, $config{dp_listen})) . '"';
# remove myself from the log destinations and exit everything
[ dp => q{quitting rcon2irc (??{$store{quitcookie}}): log_dest_udp is (.*) *} => sub {
my ($dest) = @_;
# remove myself from the log destinations and exit everything
[ dp => q{quitting rcon2irc (??{$store{quitcookie}}): log_dest_udp is (.*) *} => sub {
my ($dest) = @_;
my ($all, $cpu, $lost, $avg, $max, $sdev) = @_;
return 0 # don't complain when just on the voting screen
if !$store{playing};
my ($all, $cpu, $lost, $avg, $max, $sdev) = @_;
return 0 # don't complain when just on the voting screen
if !$store{playing};
+ if(length $config{dp_timinglog})
+ {
+ open my $fh, '>>', $config{dp_timinglog}
+ or warn "open >> $config{dp_timinglog}: $!";
+ print $fh "@{[time]} $cpu $lost $avg $max $sdev\n"
+ or warn "print >> $config{dp_timinglog}: $!";
+ close $fh
+ or warn "close >> $config{dp_timinglog}: $!";
+ }
- out dp => 0, 'sv_cmd bans', 'status 1', 'log_dest_udp', 'rcon2irc_eval set dummy 1';
+ out dp => 0, 'sv_cmd banlist', 'status 1', 'log_dest_udp', 'rcon2irc_eval set dummy 1';
$store{status_waiting} = -1;
schedule $timer => (exists $store{dp_hostname} ? $config{dp_status_delay} : 1);;
} => 1;
$store{status_waiting} = -1;
schedule $timer => (exists $store{dp_hostname} ? $config{dp_status_delay} : 1);;
} => 1;