Code: Select all
Index: openkore.pl
===================================================================
--- openkore.pl (revision 6591)
+++ openkore.pl (working copy)
@@ -56,7 +56,7 @@
selfCheck();
- my $command_obj = Commands->new();
+ my $command_obj = Commands->new();
$command = shared_clone($command_obj);
##### MAIN LOOP #####
Index: src/Commands/Other.pm
===================================================================
--- src/Commands/Other.pm (revision 0)
+++ src/Commands/Other.pm (revision 0)
@@ -0,0 +1,458 @@
+package Commands::Other;
+
+use strict;
+use threads;
+use threads::shared;
+use Utils::Exceptions;
+use Commands;
+use base qw(Commands);
+use Log qw(debug error message warning);
+use Translation qw(T TF);
+
+use Globals qw($char %config @playersID %players %timeout);
+use Utils qw(parseArgs swrite);
+use Plugins;
+use Settings;
+use Modules;
+use Misc::Config;
+use Misc::Other;
+
+sub new {
+ my $class = shift;
+ my $cmd = shift;
+ my %args = @_;
+ my $self = {};
+ bless $self, $class;
+
+ $cmd->register(["auth", "", \&cmdAuthorize, $self]);
+ $cmd->register(["chist", "", \&cmdChist, $self]);
+ $cmd->register(["conf", "", \&cmdConf, $self]);
+ $cmd->register(["damage", "", \&cmdDamage, $self]);
+ $cmd->register(["debug", "", \&cmdDebug, $self]);
+ $cmd->register(["dump", "", \&cmdDump, $self]);
+ $cmd->register(["dumpnow", "", \&cmdDumpNow, $self]);
+ $cmd->register(["eval", "", \&cmdEval, $self]);
+ $cmd->register(["exp", "", \&cmdExp, $self]);
+ $cmd->register(["help", "", \&cmdHelp, $self]);
+ $cmd->register(["ihist", "", \&cmdIhist, $self]);
+ $cmd->register(["plugin", "", \&cmdPlugin, $self]);
+ $cmd->register(["quit", "", \&cmdQuit, $self]);
+ $cmd->register(["reload", "", \&cmdReload, $self]);
+ $cmd->register(["reloadCode", "", \&cmdReloadCode, $self]);
+ $cmd->register(["storage", "", \&cmdStorage, $self]);
+ $cmd->register(["switchconf", "", \&cmdSwitchConf, $self]);
+ $cmd->register(["tank", "", \&cmdTank, $self]);
+ $cmd->register(["testshop", "", \&cmdTestShop, $self]);
+ $cmd->register(["timeout", "", \&cmdTimeout, $self]);
+ $cmd->register(["verbose", "", \&cmdVerbose, $self]);
+ $cmd->register(["version", "", \&cmdVersion, $self]);
+
+ return $self;
+}
+
+sub DESTROY {
+ my ($self) = @_;
+ $self->SUPER::DESTROY();
+}
+
+sub cmdAuthorize {
+ my (undef, undef, $args) = @_;
+ my ($arg1, $arg2) = $args =~ /^([\s\S]*) ([\s\S]*?)$/;
+ if ($arg1 eq "" || ($arg2 ne "1" && $arg2 ne "0")) {
+ error T("Syntax Error in function 'auth' (Overall Authorize)\n" .
+ "Usage: auth <username> <flag>\n");
+ } else {
+ Misc::Config::auth($arg1, $arg2);
+ }
+}
+
+sub cmdChatLogClear {
+ Misc::Other::chatLog_clear();
+ message T("Chat log cleared.\n"), "success";
+}
+
+sub cmdChist {
+ # Display chat history
+ my (undef, undef, $args) = @_;
+ $args = 5 if ($args eq "");
+
+ if (!($args =~ /^\d+$/)) {
+ error T("Syntax Error in function 'chist' (Show Chat History)\n" .
+ "Usage: chist [<number of entries #>]\n");
+
+ } elsif (open(CHAT, "<:utf8", $Settings::chat_log_file)) {
+ my @chat = <CHAT>;
+ close(CHAT);
+ message T("------ Chat History --------------------\n"), "list";
+ my $i = @chat - $args;
+ $i = 0 if ($i < 0);
+ for (; $i < @chat; $i++) {
+ message($chat[$i], "list");
+ }
+ message "----------------------------------------\n", "list";
+
+ } else {
+ error TF("Unable to open %s\n", $Settings::chat_log_file);
+ }
+}
+
+sub cmdConf {
+ my (undef, undef, $args) = @_;
+ my ($arg1) = $args =~ /^(\w*\.*\w+)/;
+ my ($arg2) = $args =~ /^\w*\.*\w+\s+([\s\S]+)\s*$/;
+
+ # Basic Support for "label" in blocks. Thanks to piroJOKE
+ if ($arg1 =~ /\./) {
+ $arg1 =~ s/\.+/\./; # Filter Out Unnececary dot's
+ my ($label, $param) = split /\./, $arg1, 2; # Split the label form parameter
+ # This line is used for debug
+ # message TF("Params label '%s' param '%s' arg1 '%s' arg2 '%s'\n", $label, $param, $arg1, $arg2), "info";
+ foreach (%config) {
+ if ($_ =~ /_\d+_label/){ # we only need those blocks witch have labels
+ if ($config{$_} eq $label) {
+ my ($real_key, undef) = split /_label/, $_, 2;
+ $real_key .= "_";
+ $real_key .= $param;
+ $arg1 = $real_key;
+ last;
+ };
+ };
+ };
+ };
+
+ if ($arg1 eq "") {
+ error T("Syntax Error in function 'conf' (Change a Configuration Key)\n" .
+ "Usage: conf <variable> [<value>|none]\n");
+
+ } elsif (!exists $config{$arg1}) {
+ error TF("Config variable %s doesn't exist\n", $arg1);
+
+ } elsif ($arg2 eq "") {
+ my $value = $config{$arg1};
+ if ($arg1 =~ /password/i) {
+ message TF("Config '%s' is not displayed\n", $arg1), "info";
+ } else {
+ if (defined $value) {
+ message TF("Config '%s' is %s\n", $arg1, $value), "info";
+ } else {
+ message TF("Config '%s' is not set\n", $arg1, $value), "info";
+ }
+ }
+
+ } else {
+ undef $arg2 if ($arg2 eq "none");
+ Plugins::callHook('Commands::cmdConf', {
+ key => $arg1,
+ val => \$arg2
+ });
+ Misc::Config::configModify($arg1, $arg2);
+ Log::initLogFiles();
+ }
+}
+
+sub cmdDamage {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+}
+
+sub cmdDebug {
+ my (undef, undef, $args) = @_;
+ my ($arg1) = $args =~ /^([\w\d]+)/;
+
+ if ($arg1 eq "0") {
+ Misc::Config::configModify("debug", 0);
+ } elsif ($arg1 eq "1") {
+ Misc::Config::configModify("debug", 1);
+ } elsif ($arg1 eq "2") {
+ Misc::Config::configModify("debug", 2);
+
+ } elsif ($arg1 eq "info") {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+ }
+}
+
+sub cmdDump {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+}
+
+sub cmdDumpNow {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+}
+
+sub cmdEval {
+ if (!$Settings::lockdown) {
+ if ($_[2] eq "") {
+ error T("Syntax Error in function 'eval' (Evaluate a Perl expression)\n" .
+ "Usage: eval <expression>\n");
+ } else {
+ package main;
+ no strict;
+ undef $@;
+ eval $_[2];
+ if (defined $@ && $@ ne '') {
+ $@ .= "\n" if ($@ !~ /\n$/s);
+ error ("%s", $@);
+ }
+ }
+ }
+}
+
+sub cmdExp {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+}
+
+sub cmdHelp {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+}
+
+sub cmdIhist {
+ # Display item history
+ my (undef, undef, $args) = @_;
+ $args = 5 if ($args eq "");
+
+ if (!($args =~ /^\d+$/)) {
+ error T("Syntax Error in function 'ihist' (Show Item History)\n" .
+ "Usage: ihist [<number of entries #>]\n");
+
+ } elsif (open(ITEM, "<", $Settings::item_log_file)) {
+ my @item = <ITEM>;
+ close(ITEM);
+ message T("------ Item History --------------------\n"), "list";
+ my $i = @item - $args;
+ $i = 0 if ($i < 0);
+ for (; $i < @item; $i++) {
+ message($item[$i], "list");
+ }
+ message("----------------------------------------\n", "list");
+
+ } else {
+ error TF("Unable to open %s\n", $Settings::item_log_file);
+ }
+}
+
+sub cmdPlugin {
+ return if ($Settings::lockdown);
+ my (undef, undef, $input) = @_;
+ my @args = split(/ +/, $input, 2);
+
+ if (@args == 0) {
+ message T("--------- Currently loaded plugins ---------\n" .
+ "# Name Description\n"), "list";
+ my $i = 0;
+ foreach my $plugin (@Plugins::plugins) {
+ next unless $plugin;
+ message(swrite(
+ "@<< @<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<",
+ [$i, $plugin->{name}, $plugin->{description}]
+ ), "list");
+ $i++;
+ }
+ message("--------------------------------------------\n", "list");
+
+ } elsif ($args[0] eq 'reload') {
+ my @names;
+
+ if ($args[1] =~ /^\d+$/) {
+ push @names, $Plugins::plugins[$args[1]]{name};
+
+ } elsif ($args[1] eq '') {
+ error T("Syntax Error in function 'plugin reload' (Reload Plugin)\n" .
+ "Usage: plugin reload <plugin name|plugin number#|\"all\">\n");
+ return;
+
+ } elsif ($args[1] eq 'all') {
+ foreach my $plugin (@Plugins::plugins) {
+ push @names, $plugin->{name};
+ }
+
+ } else {
+ foreach my $plugin (@Plugins::plugins) {
+ if ($plugin->{name} =~ /$args[1]/i) {
+ push @names, $plugin->{name};
+ }
+ }
+ if (!@names) {
+ error T("Error in function 'plugin reload' (Reload Plugin)\n" .
+ "The specified plugin names do not exist.\n");
+ return;
+ }
+ }
+
+ foreach (my $i = 0; $i < @names; $i++) {
+ Plugins::reload($names[$i]);
+ }
+
+ } elsif ($args[0] eq 'load') {
+ if ($args[1] eq '') {
+ error T("Syntax Error in function 'plugin load' (Load Plugin)\n" .
+ "Usage: plugin load <filename|\"all\">\n");
+ return;
+ } elsif ($args[1] eq 'all') {
+ Plugins::loadAll();
+ } else {
+ Plugins::load($args[1]);
+ }
+
+ } elsif ($args[0] eq 'unload') {
+ if ($args[1] =~ /^\d+$/) {
+ if ($Plugins::plugins[$args[1]]) {
+ my $name = $Plugins::plugins[$args[1]]{name};
+ Plugins::unload($name);
+ message TF("Plugin %s unloaded.\n", $name), "system";
+ } else {
+ error TF("'%s' is not a valid plugin number.\n", $args[1]);
+ }
+
+ } elsif ($args[1] eq '') {
+ error T("Syntax Error in function 'plugin unload' (Unload Plugin)\n" .
+ "Usage: plugin unload <plugin name|plugin number#|\"all\">\n");
+ return;
+
+ } elsif ($args[1] eq 'all') {
+ Plugins::unloadAll();
+
+ } else {
+ foreach my $plugin (@Plugins::plugins) {
+ if ($plugin->{name} =~ /$args[1]/i) {
+ my $name = $plugin->{name};
+ Plugins::unload($name);
+ message TF("Plugin %s unloaded.\n", $name), "system";
+ }
+ }
+ }
+
+ } else {
+ my $msg;
+ $msg = T("--------------- Plugin command syntax ---------------\n" .
+ "Command: Description:\n" .
+ " plugin List loaded plugins\n" .
+ " plugin load <filename> Load a plugin\n" .
+ " plugin unload <plugin name|plugin number#|\"all\"> Unload a loaded plugin\n" .
+ " plugin reload <plugin name|plugin number#|\"all\"> Reload a loaded plugin\n" .
+ "-----------------------------------------------------\n");
+ if ($args[0] eq 'help') {
+ message($msg, "info");
+ } else {
+ error T("Syntax Error in function 'plugin' (Control Plugins)\n");
+ error($msg);
+ }
+ }
+}
+
+sub cmdQuit {
+ Misc::Other::quit();
+}
+
+sub cmdReload {
+ my (undef, undef, $args) = @_;
+ if ($args eq '') {
+ error T("Syntax Error in function 'reload' (Reload Configuration Files)\n" .
+ "Usage: reload <name|\"all\">\n");
+ } else {
+ Misc::Other::parseReload($args);
+ }
+}
+
+sub cmdReloadCode {
+ my (undef, undef, $args) = @_;
+ if ($args ne "") {
+ Modules::addToReloadQueue(parseArgs($args));
+ } else {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+ # there is no functions.pl
+ #Modules::reloadFile("$FindBin::RealBin/src/functions.pl");
+ }
+}
+
+sub cmdStorage {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+}
+
+sub cmdSwitchConf {
+ my (undef, undef, $filename) = @_;
+ if (!defined $filename) {
+ error T("Syntax Error in function 'switchconf' (Switch Configuration File)\n" .
+ "Usage: switchconf <filename>\n");
+ } elsif (! -f $filename) {
+ error TF("Syntax Error in function 'switchconf' (Switch Configuration File)\n" .
+ "File %s does not exist.\n", $filename);
+ } else {
+ Misc::Config::switchConfigFile($filename);
+ message TF("Switched config file to \"%s\".\n", $filename), "system";
+ }
+}
+
+sub cmdTank {
+ my (undef, undef, $arg) = @_;
+ $arg =~ s/ .*//;
+
+ if ($arg eq "") {
+ error T("Syntax Error in function 'tank' (Tank for a Player)\n" .
+ "Usage: tank <player #|player name>\n");
+
+ } elsif ($arg eq "stop") {
+ Misc::Config::configModify("tankMode", 0);
+
+ } elsif ($arg =~ /^\d+$/) {
+ if (!$playersID[$arg]) {
+ error TF("Error in function 'tank' (Tank for a Player)\n" .
+ "Player %s does not exist.\n", $arg);
+ } else {
+ Misc::Config::configModify("tankMode", 1);
+ Misc::Config::configModify("tankModeTarget", $players{$playersID[$arg]}{name});
+ }
+
+ } else {
+ my $found;
+ foreach my $ID (@playersID) {
+ next if !$ID;
+ if (lc $players{$ID}{name} eq lc $arg) {
+ $found = $ID;
+ last;
+ }
+ }
+
+ if ($found) {
+ Misc::Config::configModify("tankMode", 1);
+ Misc::Config::configModify("tankModeTarget", $players{$found}{name});
+ } else {
+ error TF("Error in function 'tank' (Tank for a Player)\n" .
+ "Player %s does not exist.\n", $arg);
+ }
+ }
+}
+
+sub cmdTestShop {
+ message "Not yet implemented in AI 2008!\n", "implementToAI2008";
+}
+
+sub cmdTimeout {
+ my (undef, undef, $args) = @_;
+ my ($arg1) = $args =~ /^(\w+)/;
+ my ($arg2) = $args =~ /^\w+\s+([\s\S]+)\s*$/;
+ if ($arg1 eq "") {
+ error T("Syntax Error in function 'timeout' (set a timeout)\n" .
+ "Usage: timeout <type> [<seconds>]\n");
+ } elsif ($timeout{$arg1} eq "") {
+ error TF("Error in function 'timeout' (set a timeout)\n" .
+ "Timeout %s doesn't exist\n", $arg1);
+ } elsif ($arg2 eq "") {
+ message TF("Timeout '%s' is %s\n",
+ $arg1, $timeout{$arg1}{timeout}), "info";
+ } else {
+ Misc::Config::setTimeout($arg1, $arg2);
+ }
+}
+
+sub cmdVerbose {
+ if ($config{'verbose'}) {
+ Misc::Config::configModify("verbose", 0);
+ } else {
+ Misc::Config::configModify("verbose", 1);
+ }
+}
+
+sub cmdVersion {
+ message ($Settings::versionText), "info";
+}
+
+1;
\ No newline at end of file
Index: src/Misc/Config.pm
===================================================================
--- src/Misc/Config.pm (revision 6591)
+++ src/Misc/Config.pm (working copy)
@@ -5,6 +5,7 @@
use threads::shared;
use Globals qw(%overallAuth %config %timeout);
use Log qw(message warning error debug);
+use Translation qw(T TF);
use Plugins;
use FileParsers;
use Exporter;
@@ -16,7 +17,8 @@
configModify
bulkConfigModify
setTimeout
- saveConfigFile)],
+ saveConfigFile
+ switchConfigFile)],
);
our @EXPORT = (
@@ -157,3 +159,21 @@
writeDataFileIntact2(Settings::getControlFilename("timeouts.txt"), \%timeout);
}
+##
+# void switchConf(String filename)
+# filename: a configuration file.
+# Returns: 1 on success, 0 if $filename does not exist.
+#
+# Switch to another configuration file.
+sub switchConfigFile {
+ my $filename = shift;
+ lock (%config);
+ if (! -f $filename) {
+ error TF("%s does not exist.\n", $filename);
+ return 0;
+ }
+
+ Settings::setConfigFilename($filename);
+ FileParsers::parseConfigFile($filename, \%config);
+ return 1;
+}
Index: src/Misc/Other.pm
===================================================================
--- src/Misc/Other.pm (revision 0)
+++ src/Misc/Other.pm (revision 0)
@@ -0,0 +1,113 @@
+package Misc::Other;
+
+use strict;
+use threads;
+use threads::shared;
+use Exporter;
+use base qw(Exporter);
+
+use Globals qw($quit);
+use Log qw(error debug message warning);
+use Translation qw(T TF);
+use Settings;
+use Utils qw(getFormattedDate getHex);
+use Utils::Exceptions qw(caught);
+use FileParsers qw(parseConfigFile);
+
+our %EXPORT_TAGS = (
+ other => [qw(
+ chatLog_clear
+ dumpData
+ parseReload
+ quit)],
+);
+
+our @EXPORT = (
+ @{$EXPORT_TAGS{other}},
+);
+
+#######################################
+#######################################
+### CATEGORY: Other functions
+#######################################
+#######################################
+
+sub chatLog_clear {
+ if (-f $Settings::chat_log_file) {
+ unlink($Settings::chat_log_file);
+ }
+}
+
+sub dumpData {
+ my $msg = shift;
+ my $silent = shift;
+ my $dump;
+ my $puncations = quotemeta '~!@#$%^&*()_+|\"\'';
+
+ $dump = "\n\n================================================\n" .
+ getFormattedDate(int(time)) . "\n\n" .
+ length($msg) . " bytes\n\n";
+
+ for (my $i = 0; $i < length($msg); $i += 16) {
+ my $line;
+ my $data = substr($msg, $i, 16);
+ my $rawData = '';
+
+ for (my $j = 0; $j < length($data); $j++) {
+ my $char = substr($data, $j, 1);
+
+ if (($char =~ /\W/ && $char =~ /\S/ && !($char =~ /[$puncations]/))
+ || ($char eq chr(10) || $char eq chr(13) || $char eq "\t")) {
+ $rawData .= '.';
+ } else {
+ $rawData .= substr($data, $j, 1);
+ }
+ }
+
+ $line = getHex(substr($data, 0, 8));
+ $line .= ' ' . getHex(substr($data, 8)) if (length($data) > 8);
+
+ $line .= ' ' x (50 - length($line)) if (length($line) < 54);
+ $line .= " $rawData\n";
+ $line = sprintf("%3d> ", $i) . $line;
+ $dump .= $line;
+ }
+
+ open DUMP, ">> DUMP.txt";
+ print DUMP $dump;
+ close DUMP;
+
+ debug "$dump\n", "parseMsg", 2;
+ message T("Message Dumped into DUMP.txt!\n"), undef, 1 unless ($silent);
+}
+
+sub parseReload {
+ my ($args) = @_;
+ eval {
+ my $progressHandler = sub {
+ my ($filename) = @_;
+ message TF("Loading %s...\n", $filename);
+ };
+ if ($args eq 'all') {
+ Settings::loadAll($progressHandler);
+ } else {
+ Settings::loadByRegexp(qr/$args/, $progressHandler);
+ }
+ Log::initLogFiles();
+ };
+ if (my $e = caught('UTF8MalformedException')) {
+ error TF(
+ "The file %s must be valid UTF-8 encoded, which it is \n" .
+ "currently not. To solve this prolem, please use Notepad\n" .
+ "to save that file as valid UTF-8.",
+ $e->textfile);
+ } elsif ($@) {
+ die $@;
+ }
+}
+
+sub quit {
+ lock ($quit);
+ $quit = 1;
+ message T("Exiting...\n"), "system";
+}
