Games-Axmud
view release on metacpan or search on metacpan
lib/Games/Axmud/Generic.pm view on Meta::CPAN
if (%beforeHash || %afterHash || %beforeRemoveHash || %afterRemoveHash) {
$result = $currentObj->set_beforeAfterHashes(
$session,
\%beforeHash, \%afterHash,
\%beforeRemoveHash, \%afterRemoveHash,
);
if (! $result) {
return $self->error(
$session, $inputString,
'Failed to modify the ' . $category . ' interface \''
. $currentObj->name . '\'',
);
}
}
# If there's an active interface based upon this interface object, we need to update the
# active interface, too. We must do this in every session that shares the same world
# Do the update in every affected session, except this one
foreach my $otherSession ($axmud::CLIENT->listSessions()) {
if (
$otherSession->currentWorld eq $session->currentWorld
&& $otherSession ne $self
) {
$otherSession->updateInterfaces($currentObj, %attribHash);
}
}
# Now apply to this session
if (! $session->updateInterfaces($currentObj, %attribHash)) {
return $self->complete(
$session, $standardCmd,
ucfirst($category) . ' interface \'' . $currentObj->name . '\' modified, but'
. ' but general error while modifying the corresponding active interface(s)',
);
} else {
# There is no active interface based on this trigger (etc)
return $self->complete(
$session, $standardCmd,
'Inactive ' . $category . ' interface \'' . $currentObjName . '\' modified',
);
}
}
}
sub exportInterface {
# Called by GA::Cmd::ExportTrigger->do, ExportAlias->do, ExportMacro->do,
# ExportTimer->do and ExportHook->do
# (For the whole of this function, 'trigger' is taken to mean any of 'trigger', 'alias',
# 'macro', 'timer' or 'hook')
#
# This function adds an inactive trigger, stored in a trigger cage, to Axmud's interface
# clipboard, from where it can 'imported' to a different cage (perhaps in a different
# world, in a different session)
# This function can also be called to export an active interface directly, without
# exporting the corresponding inactive trigger stored in a trigger cage (if any)
#
# Expected arguments
# $session - The calling function's GA::Session
# $inputString - The command actually typed, e.g. 'etr mytrigger'
# $standardCmd - Standard version of the client command, e.g. 'exporttrigger'
# $category - 'trigger', 'alias', 'macro', 'timer', 'hook'
# $categoryPlural - e.g. 'triggers'
# $modelObj - The interface model object corresponding to $category
# @args - The arguments specified by the user in the ';exporttrigger' command
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 on success
my (
$self, $session, $inputString, $standardCmd, $category, $categoryPlural, $modelObj,
@args,
) = @_;
# Local variables
my (
$profCount, $profCategory, $profName, $switch, $interface, $interfaceObj,
$currentObjName, $cage, $currentObj,
);
# Check for improper arguments
if (
! defined $session || ! defined $inputString || ! defined $standardCmd
|| ! defined $category || ! defined $categoryPlural || ! defined $modelObj || ! @args
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->exportInterface', @_);
}
# Extract profile (group 1) switch options
($profCount, $profCategory, $profName, @args) = $self->extractProfileSwitches(
$session,
$inputString,
$category,
'export',
@args,
);
if (! defined $profCount) {
# Error in ->extractProfileSwitches - error message already displayed
return undef;
}
# Extract active interface (group 0) switch options
($switch, $interface, @args) = $self->extract('i', 1, @args);
if (defined $switch) {
if (! defined $interface) {
return $self->error(
$session, $inputString,
'Missing switch arguments - use \'-i <name>\' or \'-i <number>\'',
);
}
}
# Now, if the group 0 '-i' switch was specified, export the active interface
if (defined $interface) {
# @args should now be empty. If not, return an error message
if (@args) {
return $self->improper($session, $inputString);
}
# Group 0 and 1 switches can't be combined
if ($profCount) {
return $self->error(
$session, $inputString,
'Can\'t export active ' . $category . ' interface - can\'t combine the -i'
. ' switch with -w, -g, -r, -c, -x or -d',
);
}
# Check that the specified interface exists
if (
! $session->ivExists('interfaceHash', $interface)
&& ! $session->ivExists('interfaceNumHash', $interface)
) {
return $self->error(
$session, $inputString,
'Unrecognised active ' . $category . ' interface \'' . $interface . '\'',
);
}
# If $interface is a number, convert it into an interface name
if ($session->ivExists('interfaceNumHash', $interface)) {
$interface = $session->ivShow('interfaceNumHash', $interface)->name;
}
$interfaceObj = $session->ivShow('interfaceHash', $interface);
# Export the interface
$axmud::CLIENT->add_interfaceClipboardList($interfaceObj);
return $self->complete(
$session, $standardCmd,
'Active ' . $category . ' interface \'' . $interface . '\' exported to the'
. ' interface clipboard',
);
# Otherwise, if a group 1 switch was specified, export the specified interface stored in the
# cage
} else {
# 0 or 1 associated profiles can be specified, but no more
if ($profCount > 1) {
return $self->error(
$session, $inputString,
'Can\'t export an interface from multiple profiles - choose one from'
. ' -w, -g, -r, -c, -x, -d (or a named profile)',
);
# If no associated profile specified, and the -i switch wasn't used, use the current
# world as the associated profile
} elsif ($profCount == 0) {
$profCount++;
$profCategory = 'world';
$profName = $session->currentWorld->name;
}
# @args should now contain a single element, <name>. Check it exists
if (@args > 1) {
return $self->improper($session, $inputString);
} elsif (! @args) {
return $self->error(
$session, $inputString,
'Please specify the name of the ' . $category . ' interface to export (or'
. ' use \'-i <name>\' or \'-i <number>\'',
);
} else {
$currentObjName = $args[0];
}
# Find the cage matching the specified profile
$cage = $session->findCage($category, $profName);
if (! $cage) {
return $self->error(
$inputString,
'Can\'t export ' . $category . ' interface because the ' . $category
. ' cage for \'' . $profName . '\' is missing',
);
}
# Check that the cage has a trigger with this name
if (! $cage->ivExists('interfaceHash', $currentObjName)) {
if ($category eq 'alias') {
return $self->error(
$session, $inputString,
'Can\'t export alias interface because the alias cage doesn\'t'
. 'have an alias with the name \'' . $currentObjName
. '\'',
);
} else {
return $self->error(
$session, $inputString,
'Can\'t export ' . $category . ' interface because the ' . $category
. ' cage doesn\'t have a ' . $category . ' with the name \''
. $currentObjName .'\'',
);
}
} else {
# Get the blessed reference of the trigger object (but don't consult inferior cages)
$currentObj = $cage->ivShow('interfaceHash', $currentObjName);
if (! $currentObj) {
return $self->error(
$session, $inputString,
'General error exporting the ' . $category . ' interface object \''
. $currentObjName . '\'',
);
}
}
# Export the interface
$axmud::CLIENT->add_interfaceClipboardList($currentObj);
return $self->complete(
$session, $standardCmd,
'Inactive ' . $category . ' interface \'' . $currentObjName . '\' exported to the'
. ' interface clipboard',
);
}
}
sub importInterface {
# Called by GA::Cmd::ImportTrigger->do, ImportAlias->do, ImportMacro->do,
# ImportTimer->do and ImportHook->do
# (For the whole of this function, 'trigger' is taken to mean any of 'trigger', 'alias',
# 'macro', 'timer' or 'hook')
#
# This function clones all triggers in Axmud's interface clipboard, moving the copies into
# the specified cage.
#
# Expected arguments
# $session - The calling function's GA::Session
# $inputString - The command actually typed, e.g. 'itr mytrigger'
# $standardCmd - Standard version of the client command, e.g. 'importtrigger'
# $category - 'trigger', 'alias', 'macro', 'timer', 'hook'
# $categoryPlural - e.g. 'triggers'
# $modelObj - The interface model object corresponding to $category
#
# Optional arguments
# @args - The arguments specified by the user in the ';importtrigger' command
#
# Return values
# 'undef' on improper arguments or if there's an error
# 1 on success
my (
$self, $session, $inputString, $standardCmd, $category, $categoryPlural, $modelObj,
@args,
) = @_;
# Local variables
my (
$profCount, $profCategory, $profName, $cage, $failCount, $successCount, $newObj,
$result,
@interfaceList, @superiorList, @inferiorList,
);
# Check for improper arguments
if (
! defined $session || ! defined $inputString || ! defined $standardCmd
|| ! defined $category || ! defined $categoryPlural || ! defined $modelObj
) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->importInterface', @_);
}
# Extract profile (group 1) switch options
($profCount, $profCategory, $profName, @args) = $self->extractProfileSwitches(
$session,
$inputString,
$category,
'import',
@args,
);
if (! defined $profCount) {
# Error in ->extractProfileSwitches - error message already displayed
return undef;
}
# 0 or 1 associated profiles can be specified, but no more
if ($profCount > 1) {
return $self->error(
$session, $inputString,
'Can\'t import an interface to multiple profiles - choose one from'
. ' -w, -g, -r, -c, -x, -d (or a named profile)',
);
# If no associated profile specified, and the -i switch wasn't used, use the current
# world as the associated profile
} elsif ($profCount == 0) {
$profCount++;
$profCategory = 'world';
$profName = $session->currentWorld->name;
}
# @args should now contain 0 or 1 arguments
if (! @args) {
@interfaceList = $axmud::CLIENT->interfaceClipboardList;
} elsif (@args > 1) {
return $self->improper($session, $inputString);
} else {
# Find all matching named interfaces
foreach my $interfaceObj ($axmud::CLIENT->interfaceClipboardList) {
if ($interfaceObj->name eq $args[0]) {
push (@interfaceList, $interfaceObj);
}
}
if (! @interfaceList) {
return $self->error(
$inputString,
'No interface named \'' . $args[0] . '\' found in the interface clipboard',
);
}
}
# Find the cage matching the specified profile
$cage = $session->findCage($category, $profName);
if (! $cage) {
return $self->error(
$inputString,
'Can\'t import ' . $category . ' interface because the ' . $category
. ' cage for \'' . $profName . '\' is missing',
);
}
# Handle each interface in turn
$failCount = 0;
$successCount = 0;
OUTER: foreach my $interfaceObj (@interfaceList) {
# Ignore any interfaces of the wrong category (e.g. just import triggers, etc)
if ($interfaceObj->category ne $category) {
next OUTER;
}
# Check that the cage doesn't already have a trigger with the same name
if ($cage->ivExists('interfaceHash', $interfaceObj->name)) {
$failCount++;
next OUTER;
}
# Clone the interface
if ($interfaceObj->isa('Games::Axmud::Interface::Active')) {
$newObj = $interfaceObj->cloneToInactiveInterface($category);
} else {
$newObj = $interfaceObj->clone($profName);
}
if (! $newObj) {
$failCount++;
next OUTER;
}
# Tell the trigger cage that it has received a new trigger
$cage->ivAdd('interfaceHash', $newObj->name, $newObj);
# Get a list of profiles with higher priority than this one
@superiorList = $session->findSuperiorList($profCategory);
# Get a list of profiles with lower priority than this one
@inferiorList = $session->findInferiorList($profCategory);
# Check whether there are any triggers with the same name, belonging to a cage
# associated with a superior profile to this cage's profile. If none, create an
# interface for the trigger
# Also, if there is a trigger, with the same name but belonging to a cage associated
# with an inferior profile to this cage's profile, destroy its interface
# As a result, there should be exactly one interface for a trigger with this name, no
( run in 0.771 second using v1.01-cache-2.11-cpan-84e82930d8c )