Games-Axmud
view release on metacpan or search on metacpan
lib/Games/Axmud/Session.pm view on Meta::CPAN
'Temporary worlds can\'t be saved, so any world-related data gathered during',
' this session will be lost unless you set a new world profile with the',
' \';setworld\' command.',
'Alternatively, you can close this session and start a new one. Other kinds of',
' data (initial tasks, display settings, and so on) are not affected and can',
' still be saved using the \';save\' command.',
' ',
);
foreach my $line (@list) {
$self->writeText($line);
}
}
if ($self->initOfflineFlag) {
# This session is operating in 'connect offline' mode
$self->ivPoke('status', 'offline');
# Display some reassuring text, one line at a time
@list = (
'This session is running in CONNECT OFFLINE mode - data files have been loaded as',
'usual, but ' . $axmud::SCRIPT . ' is only simulating a connection to the world',
' ',
'Current world : ' . $self->currentWorld->name,
);
if ($self->currentGuild) {
push (@list, 'Current guild : ' . $self->currentGuild->name);
}
if ($self->currentRace) {
push (@list, 'Current race : ' . $self->currentRace->name);
}
if ($self->currentChar) {
$string = $self->currentChar->name;
} else {
$string = '<none>';
}
push (@list,
'Current character : ' . $string,
' ',
);
foreach my $line (@list) {
$self->writeText($line);
}
# Update this session's tab label. The TRUE argument means definitely update it.
# (Nothing happens if the session is using a simple tab)
$self->checkTabLabels(TRUE);
# Update the connection info strip object for any 'internal' windows used by this
# session (should only be one, at this point)
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
$winObj->setHostLabel($self->getHostLabelText());
}
}
# Display a list of loaded plugins
if ($axmud::CLIENT->pluginHash) {
$pluginString = '';
foreach my $pluginObj (
sort {lc($a->name) cmp lc($b->name)} ($axmud::CLIENT->ivValues('pluginHash'))
) {
if (! $pluginObj->enabledFlag) {
$pluginString .= ' -' . $pluginObj->name;
} else {
$pluginString .= ' +' . $pluginObj->name;
}
}
$self->writeText('Plugins loaded:' . $pluginString);
$self->writeText(' ');
}
# If a world hint message is set, display it now (unless the blocking flag is set)
if (! $axmud::CLIENT->blockWorldHintFlag && $self->currentWorld->worldHint) {
if ($self->currentWorld->longName) {
$string = uc($self->currentWorld->longName);
} else {
$string = uc($self->currentWorld->name);
}
$string .= ': ' . $self->currentWorld->worldHint;
$self->writeText($string);
$self->writeText(' ');
# If this is the first connection to this world, also display the message in a
# 'dialogue' window
if (! $self->currentWorld->numberConnects) {
$self->mainWin->showMsgDialogue(
'World hint',
'info',
$string .= ' (To see this message again, type \';hint\')',
'ok',
);
}
}
# If using a charset other than the default one, display it now
if ($self->sessionCharSet ne $axmud::CLIENT->constCharSet) {
$self->writeText('Using charset \'' . $self->sessionCharSet . '\'');
$self->writeText(' ');
}
# When connecting to a world, the 'Connecting...' message will appear on this line, instead
if ($self->initOfflineFlag) {
$self->writeText('Session ready');
}
# Re-enable text-to-speech after displaying the introductory system messages
$self->ivPoke('ttsTempDisableFlag', FALSE);
# Inserting a Gtk3 update here allows all of the introductory messages actually to be
# displayed, before any text-to-speech stuff is done
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->start');
# In blind mode, and only for the first session, display some helpful information
if (
$axmud::BLIND_MODE_FLAG
&& $axmud::CLIENT->sessionCount <= 1
&& ! $axmud::CLIENT->blindHelpMsgShownFlag
) {
$self->writeText(
'Axmud is ready to start. You might like to read the help for visually-impaired'
. ' users. You can open it in your web browser. In this window, type a semicolon'
. ' followed by the word blind, without any spaces. Then press return.',
);
$self->writeText(' ');
$axmud::CLIENT->set_blindHelpMsgShownFlag(TRUE);
}
# Start the session loop (to which the maintenance, timer, incoming data, task and replay
# loops are subservient)
if (! $self->startSessionLoop()) {
return $self->writeError(
'Could not start the session loop',
$self->_objClass . '->start',
);
}
if (! $self->initOfflineFlag) {
# Attempt to connect to the world
if (! $self->doConnect($self->initHost, $self->initPort)) {
# (The return value is only false when improper arguments supplied)
return undef;
}
# If an attempted connection is immediately refused by the host, $self->status will
# already be set to 'disconnected'. In that case, we don't want to do most of the
# things usually done by the rest of this function
$self->spinIncomingLoop();
if ($self->status eq 'disconnected') {
$self->stopSessionLoop();
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$axmud::CLIENT->desktopObj->restrictWidgets();
return 1;
}
}
# The session may now display received text in its 'main' window tab
$self->ivPoke('startCompleteFlag', TRUE);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$axmud::CLIENT->desktopObj->restrictWidgets();
# Handle automatic logins
if ($self->initOfflineFlag) {
# In 'connect offline' mode, the character is always marked as logged in immediately
$self->doLogin();
} else {
# Set up the automatic login (if any), but obviously don't attempt a login if we
# don't know the character's name and password
if ($self->currentWorld->loginMode ne 'none' && $self->initChar && $self->initPass) {
if (! $self->setupLogin()) {
$self->writeWarning(
'Could not set up an automatic login (in login mode '
. $self->currentWorld->loginMode
. '); use the \';login\' command after logging in manually',
$self->_objClass . '->start',
);
}
}
# Check for already-received text
if ($self->initialTextBuffer) {
# Some text has been received which we haven't displayed yet
$self->processIncomingData($self->initialTextBuffer);
# (We don't need to keep that text)
$self->ivPoke('initialTextBuffer', '');
}
}
return 1;
}
sub stop {
# Called by GA::Client->stopSession and ->stopAllSessions (only)
# Terminates the session. Any existing connection is terminated (without halting the
# session) by a call to $self->doDisconnect or to the callback $self->connectionError
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments or if the session can't be terminated
# 1 on success
my ($self, $check) = @_;
# Local variables
my $actualCount;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->stop', @_);
}
# Stop the session loop (if running)
if ($self->sessionLoopObj && ! $self->stopSessionLoop()) {
return $self->writeError(
'Could not stop the session loop',
$self->_objClass . '->stop',
);
}
# Terminate the connection, if connected (or connecting)
if (! $self->doDisconnect()) {
return $self->writeError(
'Could not terminate the connection',
$self->_objClass . '->stop',
);
}
# Update IVs
$self->ivPoke('status', 'disconnected');
# Update the world's connection history object, if one was created for this session
if ($self->connectHistoryObj) {
$self->connectHistoryObj->set_disconnectedTime();
}
# Count the number of sessions that exist, besides this one. We can't rely on
# GA::Client->sessionCount, because it might have been updated by the calling functions
$actualCount = 0;
foreach my $otherSession ($axmud::CLIENT->ivValues('sessionHash')) {
if ($otherSession ne $self) {
$actualCount++;
}
}
# Ask the 'main' window to remove the tab for this session (if allowed)
# Don't bother if sessions don't share a 'main' window (because this session's 'main'
# window is about to be closed anyway)
# (If the session has ended because the 'main' windows has been destroyed, then the call to
# $self->del_winObj will already have set $self->defaultTabObj to 'undef')
if (
$axmud::CLIENT->shareMainWinFlag
&& $self->defaultTabObj
&& ! $self->defaultTabObj->paneObj->removeSessionTab($self)
) {
return $self->writeError(
'Could not remove the tab for a session',
$self->_objClass . '->stop',
);
}
# Close any 'free' windows produced by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionFreeWins($self)) {
# As one 'free' window is closed, its child 'free' windows are also closed, so we have
# to check the window still exists, before destroying it
if ($axmud::CLIENT->desktopObj->ivExists('freeWinHash', $winObj->number)) {
$winObj->winDestroy();
}
}
# If sessions have their own workspace grids, remove the workspace grids (which closes their
# 'grid' windows, but not this session's 'main' window, which we'll deal with in a moment)
# If sessions share a workspace grid, do nothing
$axmud::CLIENT->desktopObj->removeSessionWorkspaceGrids($self);
# Remove any temporary zonemaps for this session
foreach my $zonemapObj ($axmud::CLIENT->ivValues('zonemapHash')) {
if ($zonemapObj->tempFlag && $zonemapObj->tempSession eq $self) {
$axmud::CLIENT->del_zonemap($zonemapObj);
}
}
# Check if there are any remaining 'grid' windows associated with this session and, if so,
# close them (but still don't close the 'main' window)
$axmud::CLIENT->desktopObj->removeSessionWindows($self);
# If this session has any 'external' windows on this session's workspace grid, and if this
# wasn't the current session, those 'external' windows may be invisible/minimised. Make
# them visible
$axmud::CLIENT->desktopObj->revealGridWins($self);
# Otherwise, when sessions don't share a 'main' window, we can delete it this session's
# 'main' window now
if (! $axmud::CLIENT->shareMainWinFlag) {
$self->mainWin->winDestroy();
$self->ivUndef('mainWin');
} elsif (! $actualCount && ! $axmud::CLIENT->shutdownFlag) {
# Convert the single remaining 'main' window back into a spare 'main' window
$axmud::CLIENT->desktopObj->deconvertSpareMainWin($self->mainWin);
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$axmud::CLIENT->desktopObj->restrictWidgets();
return 1;
}
# Setup
sub setMainWin {
# Called by $self->start
# Creates a new 'main' window or re-uses an existing one
#
# Expected arguments
# $currentCount - The number of sessions that exist, besides this one (so can be 0)
#
# Return values
# 'undef' on improper arguments or if the 'main' window can't be created
# 1 on success
my ($self, $currentCount, $check) = @_;
# Local variables
my (
$winmap, $winObj, $successFlag, $thisWorkspaceObj, $thisWorkspaceGridObj, $thisZoneObj,
%workspaceHash,
);
# Check for improper arguments
if (! defined $currentCount || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setMainWin', @_);
}
# If a winmap has been marked as the default for this world, use it (otherwise the function
# returns 'undef', and a default winmap is used)
$winmap = $self->checkWinmapWorlds($self->initWorld);
# If sessions share a 'main' window, create a workspace grid on every workspace for this
# session
# If sessions don't share a 'main' window, use the shared workspace grid on every
# workspace (or create one on every workspace, if this is the first session)
OUTER: foreach my $workspaceObj ($axmud::CLIENT->desktopObj->listWorkspaces()) {
my $gridObj;
if ($axmud::CLIENT->shareMainWinFlag) {
$gridObj = $workspaceObj->addWorkspaceGrid($self);
} elsif (! $currentCount) {
$gridObj = $workspaceObj->addWorkspaceGrid();
}
# (Temporarily storing workspace grid object makes the following call to
# ->createGridWin a lot simpler)
if ($gridObj) {
$workspaceHash{$workspaceObj->number} = $gridObj->number;
}
}
# Create a 'main' window, or use an existing one
if (
($axmud::CLIENT->shareMainWinFlag && $axmud::CLIENT->mainWin)
|| (! $axmud::CLIENT->shareMainWinFlag && ! $currentCount)
) {
# Use the existing shared 'main' window
$winObj = $axmud::CLIENT->mainWin;
}
if (
! $currentCount
&& (! $axmud::TEST_MODE_FLAG || $axmud::CLIENT->sessionCount)
&& $winObj
) {
# Convert a spare 'main' window into a normal one
if (! $axmud::CLIENT->desktopObj->convertSpareMainWin($self, $winObj, $winmap)) {
# Could not reposition the 'main' window, for some reason. Destroy it, and allow
# the code below to create a new one
$winObj->winDestroy();
$axmud::CLIENT->reset_mainWin();
$winObj = undef;
}
}
if (! $winObj) {
# Create a new 'main' window for this session, using the first available workspace. If
# >shareMainWinFlag = TRUE, we can specify the workspace grid to use, too
OUTER: foreach my $workspaceObj ($axmud::CLIENT->desktopObj->listWorkspaces()) {
$winObj = $workspaceObj->createGridWin(
'main', # Window type
'main', # Window name
undef, # Window title set automatically
$winmap, # Winmap name
'Games::Axmud::Win::Internal', # Package name
undef, # No known Gtk3::Window
undef, # No system internal ID
$self, # Owner
$self, # Owner session
$workspaceHash{$workspaceObj->number}, # 'undef' if ->shareMainWinFlag = FALSE
);
if ($winObj) {
# New 'main' window created on this workspace
last OUTER;
}
}
}
# Operation complete; if it failed, $winObj is 'undef'
return $winObj;
}
sub checkWinmapWorlds {
# Called by $self->setMainWin
# Some winmaps are marked for use as the 'default' winmap for a particular world. Ideally,
# each world should have no more than one winmap which is marked as the default for that
# world but, just in case, we'll check all winmaps alphabetically, using the first one we
# find
#
# Expected arguments
# $worldName - A world profile name (if called by $self->setMainWin, the same as
# $self->initWorld)
#
# Return values
# 'undef' on improper arguments or if this world has no default winmaps
# Otherwise, returns the first default winmap found
my ($self, $worldName, $check) = @_;
# Local variables
my @winmapList;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->checkWinmapWorlds', @_);
}
@winmapList = sort {lc($a->name) cmp lc($b->name)} ($axmud::CLIENT->ivValues('winmapHash'));
foreach my $winmapObj (@winmapList) {
if ($winmapObj->ivExists('worldHash', $worldName)) {
# This is the default winmap for the world
return $winmapObj->name;
lib/Games/Axmud/Session.pm view on Meta::CPAN
# Sound has finished playing. Should it repeat?
if ($soundObj->repeat > 1) {
# Repeat at least once more
$soundObj->ivDecrement('repeat');
$result = $axmud::CLIENT->repeatSoundFile($soundObj);
} elsif ($soundObj->repeat == -1) {
# Repeat indefinitely
$result = $axmud::CLIENT->repeatSoundFile($soundObj);
}
# If the call to ->repeatSoundFile failed, if the sound should only be played once
# or has finished repeating, delete the GA::Obj::Sound object
if (! $result) {
$soundObj->stop();
$self->ivDelete('soundHarnessHash', $soundObj->number);
}
}
}
# If auto-saves are turned on, see if it's time for an auto-save (but not during an MXP
# crosslinking operation)
if (
$axmud::CLIENT->autoSaveFlag
&& $self->status eq 'connected'
&& $self->autoSaveCheckTime
&& $self->autoSaveCheckTime < $self->sessionTime
&& $self->mxpRelocateMode eq 'none'
) {
# Perform the auto-save. In blind mode, don't read out the completion message
if ($axmud::BLIND_MODE_FLAG) {
$self->pseudoCmd('save', 'hide_complete');
} else {
$self->pseudoCmd('save');
}
$self->ivPoke('autoSaveLastTime', $self->sessionTime);
# Set the time at which the next auto-save will occur
$self->resetAutoSave();
}
# Handle changes to this session's tab label (if visible)
$self->checkTabLabels();
# Handle any Gtk3::TextView scrolling problems (see the comments in $self->new)
$self->forceScrollTextViews();
# Update any MXP gauges whose entities have been modified
$self->updateMxpGauges();
# If the GA::Strip::Entry strip object's console button is in flashing mode, check whether
# it's time to stop flashing
if ($self->systemMsgCheckTime && $self->systemMsgCheckTime < $self->sessionTime) {
$self->ivUndef('systemMsgCheckTime');
# Update strip objects for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if (
$stripObj
&& $winObj->visibleSession
&& $winObj->visibleSession eq $self
) {
$stripObj->reset_consoleIconFlash();
}
}
}
# Perform a delayed quit, if one has been set
if (defined $self->delayedQuitTime && $self->delayedQuitTime < $self->sessionTime) {
$self->clientCmd($self->delayedQuitCmd);
# (Only quit once)
$self->ivUndef('delayedQuitTime');
$self->ivUndef('delayedQuitCmd');
}
# Allow other loops to spin
$self->ivPoke('childLoopSpinFlag', FALSE);
return 1;
}
sub resetAutoSave {
# Called by $self->startMaintainLoop, ->spinMaintainLoop or GA::Cmd::AutoSave->do
# If auto-saves are turned on, sets the time (matches $self->sessionTime) at which the
# next auto-save will occur. If auto-saves are turned off, sets the IV to 0
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 on success
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->resetAutoSave', @_);
}
if (! $axmud::CLIENT->autoSaveFlag) {
# Auto-saves turned off
$self->ivPoke('autoSaveCheckTime', 0);
$self->ivPoke('autoSaveLastTime', 0);
} else {
# Auto-saves turned on
$self->ivPoke(
'autoSaveCheckTime',
$self->sessionTime + ($axmud::CLIENT->autoSaveWaitTime * 60),
lib/Games/Axmud/Session.pm view on Meta::CPAN
}
return $labelText;
}
sub forceScrollTextViews {
# Called by $self->spinMaintainLoop and GA::Obj::Desktop->updateWidgets
# Handle any Gtk3::TextView scrolling problems. Since the update to Gtk3, Gtk3::Textviews
# sometimes fail to scroll to the top/bottom when required
# This is corrected by compiling hashes of any textviews which were told to scroll to the
# top/bottom. Periodically (once per Axmud maintain loop, and after every Gtk3 main loop
# iteration) we forcibly scroll the marked textviews to the bottom, which takes care of
# any problems (while preserving the smooth scrolling effect)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $gtkFlag - Set to TRUE when called by GA::Obj::Desktop->updateWidgets
#
# Return values
# 'undef' on improper arguments
# 1 on success
my ($self, $gtkFlag, $check) = @_;
# Local variables
my (%upHash, %downHash);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->forceScrollTextViews', @_);
}
# For any textviews which had been scrolled to the top, forcibly scroll them to the top
%upHash = $self->textViewScrollUpHash;
$self->ivEmpty('textViewScrollUpHash');
foreach my $textView (values %upHash) {
$textView->get_vadjustment->set_value(0);
}
# For any textviews which had been scrolled to the bottom, forcibly scroll them to the
# bottom
%downHash = $self->textViewScrollDownHash;
$self->ivEmpty('textViewScrollDownHash');
foreach my $textView (values %downHash) {
my $adjust = $textView->get_vadjustment();
$adjust->set_value($adjust->get_upper() - $adjust->get_page_size());
}
if (%upHash || %downHash) {
# (Avoid infinite recursion)
if (! $gtkFlag) {
$axmud::CLIENT->desktopObj->updateWidgets();
}
# Check the textviews have actually scrolled to the correct position
foreach my $textView (values %upHash) {
if ($textView->get_vadjustment->get_value()) {
# Forced scrolling wasn't successful, so try again on the next maintain loop
$self->ivAdd('textViewScrollUpHash', $textView, $textView);
}
}
foreach my $textView (values %downHash) {
my $adjust = $textView->get_vadjustment();
if ($adjust->get_value() < ($adjust->get_upper() - $adjust->get_page_size())) {
# Forced scrolling wasn't successful, so try again on the next maintain loop
$self->ivAdd('textViewScrollDownHash', $textView, $textView);
}
}
}
return 1;
}
sub setCrawlMode {
# Called by GA::Cmd::Crawl->do
# Enables crawl mode, setting a temporary limit on the number of world commands that can be
# sent per second
#
# Expected arguments
# $num - The command limit per second
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $num, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->setCrawlMode', @_);
}
$self->ivPoke('crawlModeFlag', TRUE);
$self->ivPoke('crawlModeCmdLimit', $num);
$self->ivPoke('crawlModeCheckTime', $self->sessionTime + $self->crawlModeWaitTime);
return 1;
}
sub resetCrawlMode {
# Called by $self->spinMaintainLoop and GA::Cmd::Crawl->do
# Disables crawl mode, removing a temporary limit on the number of world commands that can
# be sent per second. (If the current world profile specifies a limit, that limit then
lib/Games/Axmud/Session.pm view on Meta::CPAN
# Don't call the task on the next task loop, but after a delay
$self->ivAdd(
'taskCallHash',
$taskObj->uniqueName,
$self->sessionTime + $taskObj->delayTime,
);
} else {
# Call the task on the next task loop
$self->ivAdd('taskCallHash', $taskObj->uniqueName, 0);
}
}
# Activity tasks
} elsif ($taskObj->category eq 'activity') {
if ($taskObj->shutdownFlag) {
# This an activity task whose shutdown flag has been set
$taskObj->shutdown();
} elsif ($taskObj->status eq 'reset') {
# This an activity task which must be reset
$taskObj->reset();
}
}
}
# If the data viewer window is open at the tab containing the list of current tasks,
# re-draw the list
if ($self->viewerWin) {
$currentTab = $self->viewerWin->notebookGetTab();
if (defined $currentTab && $currentTab eq 'Current tasklist') {
# If there are currently any selected lines in the tab's GA::Obj::SimpleList,
# remember them, so we can select them again as soon as the list is redrawn
@selectedList = $self->viewerWin->notebookGetSelectedLines();
# Redraw the list
$self->viewerWin->currentTaskHeader();
if (@selectedList) {
# Re-select each selected line
$self->viewerWin->notebookSetSelectedLines(@selectedList);
}
}
}
# At least one task loop has completed
$self->ivPoke('firstTaskLoopCompleteFlag', TRUE);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions (if a task
# has started or stopped during this task loop or if a Axbasic script has resumed)
if ($resetWinFlag) {
$axmud::CLIENT->desktopObj->restrictWidgets();
}
# Allow other loops to spin
$self->ivPoke('childLoopSpinFlag', FALSE);
return 1;
}
sub compileTasks {
# Called by $self->spinTaskLoop at various points during its spin
# Extracts a list of tasks from the current tasklist
# Moves those tasks which must be processed first to the front of the list, and those tasks
# which must be processed last to the end of the list
# Returns the modified list
#
# Expected arguments
# (none besides $self)
#
# Return values
# An empty list on improper arguments
# Otherwise, returns the modified list
my ($self, $check) = @_;
# Local variables
my (@emptyList, @taskList, @initialList, @firstList, @lastList);
# Check for improper arguments
if (defined $check) {
$axmud::CLIENT->writeImproper($self->_objClass . '->compileTasks', @_);
return @emptyList;
}
# Compile a list of active process tasks that must be called. Activity tasks must also be
# called if their shutdown flag has been set, or if they must be reset
@taskList = $self->ivValues('currentTaskHash');
# Go through the list, removing any tasks on the 'first' runlist (tasks that must be run
# first, before any others)
if ($axmud::CLIENT->taskRunFirstList) {
OUTER: foreach my $string ($axmud::CLIENT->taskRunFirstList) {
@initialList = @taskList;
@taskList = ();
INNER: foreach my $taskObj (@initialList) {
if ($taskObj->name eq $string) {
push (@firstList, $taskObj);
} else {
push (@taskList, $taskObj);
}
}
}
}
# Now remove tasks on the 'last' runlist (tasks that must be run last, before any others)
lib/Games/Axmud/Session.pm view on Meta::CPAN
# Read incoming data
# v1.0.242 - Surprisingly, ->get doesn't return all the data that has been received; this
# can lead to ->processIncomingData being called to process half a line, when the rest of
# the line has actually been received by GA::Obj::Telnet (bad news for any triggers that
# might match the whole line). Therefore we need to continue polling GA::Obj::Telnet until
# it returns 'undef'
$text = '';
do {
$result = $self->connectObj->get(
Errmode => sub { }, # Do nothing on error
Timeout => 0,
);
if (defined $result) {
$text .= $result;
}
} until (! defined $result);
if ($text) {
# Check our status and amend it, if need be
if ($self->status eq 'connecting') {
$self->connectionComplete();
}
# Decode $text from the world's character set into standard Perl utf-8
if ($self->sessionCharSet ne 'null') {
$text = Encode::decode($self->sessionCharSet, $text);
}
if ($self->startCompleteFlag) {
# Display the text in the 'main' window, if $self->start has finished its jobs...
$self->processIncomingData($text);
} else {
# ...otherwise store the incoming text and wait for $self->start to finish
$self->ivPoke('initialTextBuffer', $self->initialTextBuffer . $text);
}
# If this session isn't the 'main' window's visible session, set the flag which tells
# $self->getTabLabelText (and ->checkTabLabels) that the tab's label colour should be
# changed
if ($self->mainWin->visibleSession && $self->mainWin->visibleSession ne $self) {
$self->ivPoke('showNewTextFlag', TRUE);
}
}
# Convert text to speech, if required
if ($axmud::CLIENT->systemAllowTTSFlag && $self->ttsBuffer) {
# Make sure the received text is visible in the 'main' window...
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->spinIncomingLoop');
# ...before converting text to speech
if (
$axmud::CLIENT->ttsVerboseFlag
&& defined $self->ttsLastType
&& $self->ttsLastType ne 'receive'
) {
# Last TTS conversion was something other than received text
$axmud::CLIENT->tts(
'Received text: ' . $self->ttsBuffer,
'receive',
'receive',
$self,
);
} else {
# (Don't read out 'received text' again and again and again!
$axmud::CLIENT->tts($self->ttsBuffer, 'receive', 'receive', $self);
}
}
# Always empty the buffer, in case ->systemAllowTTSFlag has been set in the last microsecond
# (or something)
$self->ivPoke('ttsBuffer', '');
# We can now display an automatic login confirmation message, if one has been prepared
if ($self->loginConfirmText) {
$self->writeText($self->loginConfirmText);
$self->ivUndef('loginConfirmText');
}
# Allow other loops to spin
$self->ivPoke('childLoopSpinFlag', FALSE);
return 1;
}
sub doConnect {
# Called by $self->start, and also by $self->mxpDoRelocate
# Attempts to connect to the world specified by $self->host and $self->port
#
# Expected arguments
# $host - The world's host address (default 127.0.0.1)
# $port - The world's port (default 23)
#
# Optional arguments
# $protocol - When called by $self->mxpDoRelocate, the protocol to use ('telnet', 'ssh'
# or 'ssl')
#
# Return values
# 'undef' on improper arguments or if the attempted connection fails
# 1 otherwise
my ($self, $host, $port, $protocol, $check) = @_;
# Local variables
my (
$user, $pass, $capProtocol, $connectObj, $longHost, $sshObj, $ptyObj, $pid, $sslObj,
$historyObj,
);
# Check for improper arguments
if (! defined $host || ! defined $port || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doConnect', @_);
}
# Make sure any 'Connecting...' messages are visible immediately
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->doConnect');
# Decide which protocol to use, if one was not specified by the calling function
if (! $protocol) {
if ($self->initProtocol) {
$protocol = $self->initProtocol;
} elsif ($self->currentWorld->protocol) {
$protocol = $self->currentWorld->protocol;
}
}
# Failsafe - default protocol is 'telnet'. If SSL is not available on this system, any SSL
# connection reverts to a telnet connection
if (
! $protocol
|| ($protocol ne 'telnet' && $protocol ne 'ssh' && $protocol ne 'ssl')
|| ($axmud::NO_SSL_FLAG && $protocol eq 'ssl')
) {
$protocol = 'telnet';
}
# If using a temporary profile and the 'ssh' protocol, prompt the user for an SSH username/
# password. If the user declines to provide one, revert to the 'telnet' protocol
# The same thing happens if the current world profile doesn't provide at least a
# ->sshUserName
if ($protocol eq 'ssh') {
if (
($self->initTempFlag && $self->initSshFlag)
|| ! $self->currentWorld->sshUserName
) {
# Prompt the user for an SSH username/password
($user, $pass) = $self->mainWin->showDoubleEntryDialogue(
'SSH login',
'Enter the SSH username',
'Enter the SSH password',
);
if ($user && $pass) {
# Update the world profile's IVs
$self->currentWorld->ivPoke('protocol', 'ssh');
$self->currentWorld->ivPoke('sshUserName', $user);
if ($pass) {
$self->currentWorld->ivPoke('sshPassword', $pass);
}
} else {
# Default back to telnet
$protocol = 'telnet';
$self->writeText(
'SSH username/password not set; reverting to a telnet connection...',
);
$self->writeText(' '); # Blank line
}
} else {
$user = $self->currentWorld->sshUserName;
$pass = $self->currentWorld->sshPassword;
}
}
# (Make sure any system messages so far are actually visible, in case the connection hangs,
# by calling GA::Obj::Desktop->updateWidgets
if ($self->mxpRelocateMode eq 'none') {
if ($protocol eq 'telnet') {
$capProtocol = $protocol;
} else {
$capProtocol = uc($protocol);
}
$self->writeText(
'Connecting (via ' . $capProtocol . ') to \'' . $host . ' ' . $port . '\'...',
);
}
# Update some initial IVs, so that we can call $self->getHostLabelText
$self->ivPoke('protocol', $protocol);
$self->ivPoke('status', 'connecting');
# Create a new connection history object, if allowed
if ($axmud::CLIENT->connectHistoryFlag) {
$historyObj = Games::Axmud::Obj::ConnectHistory->new($self);
if ($historyObj) {
# Update session IVs
$self->ivPoke('connectHistoryObj', $historyObj);
# Update the object's ->currentTime every second
$self->ivPoke('historyCheckTIme', $self->sessionTime + 1);
# Update world profile IVs
$self->currentWorld->ivPush('connectHistoryList', $historyObj);
}
}
# Update the connection info strip object for any 'internal' windows used by this
# session (should only be one, at this point)
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
$winObj->setHostLabel($self->getHostLabelText());
}
# Make sure any system messages so far are actually visible, in case the connection hangs
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->doConnect');
# Connect to the world using the specified protocol
if ($protocol eq 'telnet') {
# Connect using GA::Obj::Telnet
$connectObj = Games::Axmud::Obj::Telnet->new(
Axmud_session => $self,
Errmode => 'return',
Timeout => $self->connectTimeOut,
);
if (! $connectObj) {
$self->writeError(
'System telnet error',
$self->_objClass . '->doConnect',
);
# React to the disconnection
$self->reactDisconnect();
# Return 'undef' to show failure
return undef;
}
} elsif ($protocol eq 'ssh') {
# The first argument in the call to Net::OpenSSH->new is in the form
# 'jack@foo.bar.com'
# 'jack:secret@foo.bar.com:10022');
# 'jsmith@2001:db8::1428:57ab'); # IPv6
# In addition, IPv6 addresses can be enclosed in brackets (which we will do)
# 'jsmith@[::1]:1022'
# Compose the first argument
$longHost = $user;
if ($pass) {
$longHost .= ':' . $pass;
}
if ($self->currentWorld->ipv6 && $self->currentWorld->ipv6 eq $host) {
$longHost .= '@[' . $host . ']';
} else {
$longHost .= '@' . $host;
}
if ($self->currentWorld->sshPortFlag) {
$longHost .= ':' . $port;
}
# Connect using Net::OpenSSH
$sshObj = Net::OpenSSH->new(
$longHost,
timeout => $self->connectTimeOut,
master_opts => [ -o => "StrictHostKeyChecking=no" ],
);
if ($sshObj) {
lib/Games/Axmud/Session.pm view on Meta::CPAN
if ($self->defaultTabObj) {
$self->defaultTabObj->textViewObj->showSystemText('Disconnected from host');
}
# Update IVs (if allowed)
if (! $flag) {
$self->ivUndef('protocol');
$self->ivUndef('connectObj');
$self->ivUndef('sshObj');
$self->ivUndef('ptyObj');
$self->ivUndef('sslObj');
if (! $axmud::CLIENT->offlineOnDisconnectFlag) {
$self->ivPoke('status', 'disconnected');
} else {
$self->ivPoke('status', 'offline');
}
$self->ivPoke('mxpRelocateMode', 'none');
$self->ivUndef('delayedQuitTime');
$self->ivUndef('delayedQuitCmd');
if (! $axmud::CLIENT->offlineOnDisconnectFlag) {
$self->ivPoke('disconnectTime', $axmud::CLIENT->localClock);
} else {
$self->ivPoke('disconnectTime', undef);
}
if (! $axmud::CLIENT->offlineOnDisconnectFlag) {
$self->ivEmpty('interfaceHash');
$self->ivEmpty('interfaceNumHash');
$self->ivPoke('interfaceCount', 0);
$self->ivEmpty('deleteInterfaceList');
$self->ivEmpty('triggerHash');
$self->ivEmpty('triggerOrderList');
$self->ivEmpty('aliasHash');
$self->ivEmpty('aliasOrderList');
$self->ivEmpty('macroHash');
$self->ivEmpty('macroOrderList');
$self->ivEmpty('timerNumHash');
$self->ivEmpty('timerClockHash');
$self->ivUndef('timerLastClock');
$self->ivEmpty('timerOrderList');
$self->ivEmpty('hookHash');
$self->ivEmpty('hookOrderList');
}
# Update the world's connection history object, if one was created for this session
if ($self->connectHistoryObj) {
$self->connectHistoryObj->set_disconnectedTime();
}
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$axmud::CLIENT->desktopObj->restrictWidgets();
# Make sure the command entry box isn't obscured in any 'internal' windows used by this
# session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if ($stripObj) {
$stripObj->obscureEntry(FALSE);
}
}
}
# Operation complete
$self->ivPoke('doDisconnectFlag', FALSE);
return 1;
}
sub doTempDisconnect {
# Alternative to ->doDisconnect, called by $self->mxpDoRelocate
# Disconnects the current connection, but doesn't reset all IVs, in the expectation that
# some of them apply to the new server, once the connection to it is completed
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doTempDisconnect', @_);
}
# Terminate the connection
$self->connectObj->close();
# (Allow MSP sound files, if any, to continue playing)
# Show confirmation
if (! $self->mxpRelocateQuietFlag) {
$self->writeText(
'Relocating (via ' . $self->protocol . ') to new server, \'' . $self->initHost
. ' ' . $self->initPort . '\'...',
);
}
# Update (some) IVs
$self->ivUndef('connectObj');
$self->ivUndef('sshObj');
$self->ivUndef('ptyObj');
$self->ivUndef('sslObj');
$self->ivPoke('status', 'disconnected');
$self->ivPoke('loginFlag', FALSE);
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$axmud::CLIENT->desktopObj->restrictWidgets();
# Make sure the command entry box isn't obscured in any 'internal' windows used by this
# session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if ($stripObj) {
$stripObj->obscureEntry(FALSE);
}
}
return 1;
}
sub reactDisconnect {
# Called by $self->connectionError when the GA::Obj::Telnet object reports an error (usually
# due to the host disconnecting us)
# Also called by ->incomingDataLoop when it reads an end-of-file (usually due to the host
# disconnecting us)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $flag - If TRUE, a confirmation message has already been displayed (by a call to
# $self->doDisconnect). If FALSE (or 'undef'), this function must display a
# confirmation message
#
# Return values
# 'undef' on improper arguments, if a call to $self->doDisconnect hasn't finished yet or
# if this function has already been called
# 1 otherwise
my ($self, $flag, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->reactDisconnect', @_);
}
# On disconnection, this function might be called before $self->doDisconnect has finished
# (such as during blind mode, when the 'Disconnected' message is still being read aloud).
# Use a flag to prevent this
if ($self->doDisconnectFlag) {
return undef;
# On disconnection, this function is called from several places in the session code. In
# rare circumstances (such as the GA::Obj::Telnet object returning TRUE to an ->eof()
# call), it might be called more than once. Use a flag to ignore subsequent calls
} elsif ($self->reactDisconnectFlag) {
return undef;
} else {
# Ignore subsequent calls to this function
$self->ivPoke('reactDisconnectFlag', TRUE);
}
# Turn off overwrite mode in the session's default textview object (if on), allowing
lib/Games/Axmud/Session.pm view on Meta::CPAN
if ($axmud::CLIENT->offlineOnDisconnectFlag) {
$self->writeText('Switching to \'connect offline\' mode');
}
# Fire any hooks that are using the 'disconnect' hook event (but only while connected, and
# if allowed)
if ($self->status eq 'connected') {
$self->checkHooks('disconnect');
}
# Empty the repeat object and excess command lists - we don't want to continue sending
# commands after a disconnection
$self->ivEmpty('repeatObjList');
$self->ivPoke('excessCmdCount', 0);
$self->ivEmpty('excessCmdList');
$self->ivPoke('crawlModeFlag', FALSE);
$self->ivPoke('crawlModeCmdLimit', undef);
$self->ivPoke('crawlModeCheckTime', undef);
# Save files (but only while connected, or while disconnecting; and only if allowed)
if (
(
$self->status eq 'connected'
|| $self->status eq 'disconnected'
|| $self->status eq 'offline'
) && ! $self->disconnectNoSaveFlag
) {
$self->pseudoCmd('save');
}
# Update IVs
$self->ivUndef('protocol');
$self->ivUndef('connectObj');
$self->ivUndef('sshObj');
$self->ivUndef('ptyObj');
$self->ivUndef('sslObj');
if (! $axmud::CLIENT->offlineOnDisconnectFlag) {
$self->ivPoke('status', 'disconnected');
} else {
$self->ivPoke('status', 'offline');
}
$self->ivPoke('mxpRelocateMode', 'none');
$self->ivUndef('delayedQuitTime');
$self->ivUndef('delayedQuitCmd');
if (! $axmud::CLIENT->offlineOnDisconnectFlag) {
$self->ivPoke('disconnectTime', $axmud::CLIENT->localClock);
} else {
$self->ivPoke('disconnectTime', undef);
}
if (! $flag) {
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$axmud::CLIENT->desktopObj->restrictWidgets();
}
if (! $axmud::CLIENT->offlineOnDisconnectFlag) {
# Remove all active interfaces
$self->ivEmpty('interfaceHash');
$self->ivEmpty('interfaceNumHash');
$self->ivPoke('interfaceCount', 0);
$self->ivEmpty('deleteInterfaceList');
$self->ivEmpty('triggerHash');
$self->ivEmpty('triggerOrderList');
$self->ivEmpty('aliasHash');
$self->ivEmpty('aliasOrderList');
$self->ivEmpty('macroHash');
$self->ivEmpty('macroOrderList');
$self->ivEmpty('timerNumHash');
$self->ivEmpty('timerClockHash');
$self->ivUndef('timerLastClock');
$self->ivEmpty('timerOrderList');
$self->ivEmpty('hookHash');
$self->ivEmpty('hookOrderList');
# Stop the session loop for this session (if running; not a fatal error if the loop
# can't be stopped, as we still need to terminate the connection itself)
if ($self->sessionLoopObj && ! $self->stopSessionLoop()) {
$self->writeError(
'Could not stop the session loop',
$self->_objClass . '->reactDisconnect',
);
}
# Close any 'free' windows produced by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionFreeWins($self)) {
# As one 'free' window is closed, its child 'free' windows are also closed, so we
# have to check the window still exists, before destroying it
if ($axmud::CLIENT->desktopObj->ivExists('freeWinHash', $winObj->number)) {
$winObj->winDestroy();
}
}
# Check if there are any remaining 'grid' windows associated with this session and, if
# so, close them (but still don't close the 'main' window)
$axmud::CLIENT->desktopObj->removeSessionWindows($self);
# If this session has any 'external' windows on this session's workspace grid, and if
# this wasn't the current session, those 'external' windows may be invisible/
# minimised. Make them visible
$axmud::CLIENT->desktopObj->revealGridWins($self);
} else {
# After switching to 'offline' mode, reset all running tasks (as if the session had just
# started in 'offline' mode
foreach my $taskObj ($self->ivValues('currentTaskHash')) {
if ($taskObj->status eq 'running' || $taskObj->status eq 'paused') {
$taskObj->set_status('reset');
}
}
# Spin the task loop so that current tasks are reset immediately
$self->spinTaskLoop();
}
# Update this session's tab label to mark the session as disconnected (or in 'offline'
# mode). The TRUE flag forces the function to update the tab label
$self->checkTabLabels(TRUE);
# Update strip objects for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj;
# Update information stored in each 'internal' window's connection info strip, if
# visible
$winObj->setHostLabel($self->getHostLabelText());
$winObj->setTimeLabel($self->getTimeLabelText());
# Reset the 'internal' window's entry box
$winObj->resetEntry();
$stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if (
$stripObj
&& $winObj->visibleSession
&& $winObj->visibleSession eq $self
) {
$stripObj->obscureEntry(FALSE);
# Must stop the console button from flashing, because this session's maintain loop
# is also halting if we're now in 'disconnected' mode
$stripObj->reset_consoleIconFlash();
}
# Reset the 'internal' window's blinkers, if any
$self->turnOffBlinker(-1); # Turn them all off
$winObj->resetBlinkers();
if (! $axmud::CLIENT->offlineOnDisconnectFlag) {
# Remove all gauges for this session, and redraw the gauge box
# The TRUE flag means that the gauge box should be removed immediately if there are
# no gauges left (belonging to other sessions), rather than waiting a few seconds,
# as we normally would
$stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::GaugeBox');
if ($stripObj) {
$stripObj->removeSessionGauges($self, TRUE);
}
}
}
# Make sure all changes are visible immediately
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->reactDisconnect');
# Update gauge IVs stored by MXP
$self->ivUndef('mxpGaugeLevel');
$self->ivEmpty('mxpGaugeHash');
return 1;
}
sub connectionError {
# Callback, called by $self->doConnect when the GA::Obj::Telnet object reports an error
# (usually due to a disconnection)
#
# Expected arguments
# $errorMsg - The error message passed by GA::Obj::Telnet
#
# Return values
# 'undef'
my ($self, $errorMsg, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->connectionError', @_);
}
# NB If attempting a connection to a host, where both the host address and host port are
# invalid (c.f. 'telnet deathmud'), this function is called twice. If we are already
# disconnected, don't display a second error
if ($self->status eq 'disconnected' || $self->status eq 'offline') {
return undef;
}
# If GA::Obj::Telnet's error message is one we recognise, use our own error message
if (
$errorMsg =~ m/Name or service not known/i
|| $errorMsg =~ m/Unknown (remote|local) host/i
) {
if ($self->mxpRelocateMode eq 'none') {
$self->writeText(
'Unrecognised host \'' . $self->initHost . '\'',
$self->_objClass . '->connectionError',
);
} else {
# During an MXP crosslinking operation, show a longer message so the user isn't
# left bewildered by a sudden disconnection message when the world specified a
# <QUIET> relocation
$self->writeText(
'Relocation to new server failed, unrecognised host \''
. $self->mxpRelocateHost . '\'',
$self->_objClass . '->connectionError',
);
}
# React to the disconnection. The TRUE flag means that we've already displayed a message
lib/Games/Axmud/Session.pm view on Meta::CPAN
}
# React to the disconnection
$self->reactDisconnect(TRUE);
} else {
# Otherwise, use the error message GA::Obj::Telnet gave us
$self->writeError(
ucfirst($errorMsg),
$self->_objClass . '->connectionError',
);
# React to the disconnection. Let $self->reactDisconnect display the standard
# 'Connection terminated by host' message
$self->reactDisconnect(FALSE);
}
# GA::Obj::Telnet requires us to return 'undef'
return undef;
}
sub connectionComplete {
# Called by $self->spinIncomingLoop when the first text is received by the world, which
# signals that the connection is complete
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->connectionComplete', @_);
}
# We are now connected
$self->ivPoke('status', 'connected');
if (! $self->mxpRelocateQuietFlag) {
$self->writeText('Connected');
}
# Store the time at which the connection was actually achieved, so GA::Strip::ConnectInfo
# can use it as a tooltip
# (After an MXP crosslinking operation, the time connected to the new server is displayed)
$self->ivPoke('connectedTimeString', $axmud::CLIENT->localTime());
# Update the world's connection history object, if one was created for this session
if ($self->connectHistoryObj) {
$self->connectHistoryObj->set_connectedTime();
}
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$axmud::CLIENT->desktopObj->restrictWidgets();
# Update the connection info strip object for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
$winObj->setHostLabel(
$self->getHostLabelText(),
'Connected since ' . $self->connectedTimeString,
);
}
# (Make sure that message is visible immediately)
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->connectionComplete');
if ($self->currentWorld->loginMode eq 'immediate') {
# Automatic login mode 'immediate' - immediate login (character marked as 'logged in' as
# soon as the connection is established)
$self->doLogin();
} else {
# Set the time at which $self->spinMaintainLoop should show a warning that the character
# hasn't logged in yet
$self->ivPoke(
'loginWarningTime',
($self->sessionTime + $axmud::CLIENT->loginWarningTime),
);
}
# Fire any hooks that are using the 'connect' hook event
$self->checkHooks('connect');
return 1;
}
# (Process incoming data)
sub processIncomingData {
# Called by $self->spinIncomingLoop when text is received from the world
# Also called by $self->start when it's finished its setup jobs, and needs to display any
# text received from the world in the meantime
# Called by GA::Cmd::SimulateWorld->do to simulate text received from the world
#
# Processes the received text. Calls $self->tokeniseIncomingData to convert into a series
# of tokens, then processes the tokens, before calling $self->respondIncomingData to
# display a complete or partial line
#
# Expected arguments
# $text - The received text to process
#
# Optional arguments
# $noBlinkFlag - If set to TRUE, a blinker in 'internal' windows for this session is
# not turned on. If set to FALSE (or 'undef'), the blinker is turned
# on as normal. This flag can be set to TRUE if this function is
# called to display text that wasn't actually received from the world
# (e.g. when called by the ';simulateworld' client command)
#
# Return values
# 'undef' on improper arguments or if $text is an empty string
# 1 otherwise
my ($self, $text, $noBlinkFlag, $check) = @_;
# Local variables
my $enableFlag;
# Check for improper arguments
if (! defined $text || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->processIncomingData', @_);
}
lib/Games/Axmud/Session.pm view on Meta::CPAN
$self->processStripLine,
$self->processTagHash,
);
}
}
# Apply any links created by MXP <A> and <SEND> tags to the current textview (if the current
# textview was changed during the call to this function, any links for other textviews
# have already been applied)
foreach my $linkObj ($self->mxpTempLinkList) {
$self->currentTabObj->textViewObj->add_incompleteLink($linkObj);
}
$self->ivEmpty('mxpTempLinkList');
# Turn on special echo mode, if necessary
if (
$self->specialEchoMode eq 'waiting'
&& $self->defaultTabObj->textViewObj->bufferTextFlag
) {
if ($self->echoMode ne 'client_agree') {
# The world has turned off echo mode, so special echo mode is not required during
# this session
$self->ivPoke('specialEchoMode', 'normal');
} else {
# The world has not turned off echo mode, so we need to take action, depending on
# whether direct keys are enabled in this session, or not
if ($self->currentWorld->ivExists('termOverrideHash', 'useDirectKeysFlag')) {
$enableFlag = $self->currentWorld->ivShow(
'termOverrideHash',
'useDirectKeysFlag',
);
} else {
$enableFlag = $axmud::CLIENT->useDirectKeysFlag;
}
if (! $enableFlag) {
# Special echo mode is currently disabled (but might be re-enabled at any time,
# if direct keys are re-enabled in this session)
$self->ivPoke('specialEchoMode', 'disabled');
} else {
$self->ivPoke('specialEchoMode', 'enabled');
}
# Inform all strip entry objects (GA::Strip::Entry) of the change
$self->updateSpecialEcho();
}
}
# Update the connection info strip object for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
# Update information stored in each 'internal' window's connection info strip,
# if visible
$winObj->setTimeLabel($self->getTimeLabelText());
}
# Set the 'main' window's urgency hint, if allowed
if ($axmud::CLIENT->mainWinUrgencyFlag || $axmud::CLIENT->tempUrgencyFlag) {
# The TRUE argument means only set the hint, if it's not already set
$self->mainWin->setUrgent(TRUE);
# If ->tempUrgencyFlag is set (and assuming ->mainWinUrgencyFlag is not set), the 'main'
# window's urgency hint should only be set once
if ($axmud::CLIENT->tempUrgencyFlag) {
$axmud::CLIENT->set_tempUrgencyFlag(FALSE);
}
}
# Play a sound effect to signal that some text has been received, if allowed
if ($axmud::CLIENT->tempSoundFlag) {
$axmud::CLIENT->playSound('afk');
# The sound should only be played once
$axmud::CLIENT->set_tempSoundFlag(FALSE);
}
return 1;
}
sub tokeniseIncomingData {
# Called by $self->processIncomingData, and also by $self->processPuebloPaneElement
# Tokenises the text received from the world, producing a list in groups of two, in the form
# (type, argument, type, argument...)
# Where 'type' is one of the strings 'nl', 'ga', 'esc', 'inv', 'ctrl', 'seq', 'bsp', 'msp',
# 'mxp', 'ent', 'pueblo', 'mcp', 'nomcp' or 'text', and 'argument' is usually the token,
# but in the case of an escape sequence is a reference to a list of values. In that list,
# the first value is the token, the second is an argument, and the third is one of the
# sequence types 'osc', 'mxp', 'sqr', 'vt', 'xterm', 'trcol_fg' or 'trcol_bg'
#
# The list is stored in $self->currentTokenList, rather than in a local variable in the
# calling function
#
# Expected arguments
# $text - The incoming text to tokenise
#
# Optional arguments
# $insertAtStartFlag - TRUE when called by $self->processPuebloPaneElement, in which case
# the tokens are inserted at the beginning of $self->currentTokenList, so they are
# processed before any existing tokens (in other words, process the file we just
# downloaded from a URL, before continuing to process data received over the telnet/
# SSH/SSL connection). FALSE (or 'undef') otherwise
#
# Return values
# 'undef' on improper arguments or if $text is an empty string
# 1 otherwise
lib/Games/Axmud/Session.pm view on Meta::CPAN
$newTop = $resizeTop;
$newBottom = $resizeTop + $reduceHeight - 1;
$resizeTop += $reduceHeight;
} elsif ($frameObj->align eq 'bottom') {
$resizeBottom -= $reduceHeight;
$newTop = $resizeBottom + 1;
$newBottom = $newTop + $reduceHeight - 1;
}
$self->defaultTabObj->paneObj->stripObj->resizeTableObj(
$self->defaultTabObj->paneObj,
$resizeLeft,
$resizeRight,
$resizeTop,
$resizeBottom,
);
# Add a new pane object in the newly-available space
$newPaneObj = $self->defaultTabObj->paneObj->stripObj->addTableObj(
'Games::Axmud::Table::Pane',
$newLeft,
$newRight,
$newTop,
$newBottom,
'mxp_frame_' . $frameObj->name,
# Configuration hash
'frame_title' => $ivHash{'name'},
);
if (! $newPaneObj) {
$self->mxpDebug(
$origToken,
'Internal error creating frame \'' . $ivHash{'name'} . '\'',
2721,
);
return @emptyList;
}
# Add a tab
$tabObj = $newPaneObj->addSimpleTab($self);
if (! $tabObj) {
$self->mxpDebug(
$origToken,
'Internal error creating frame \'' . $ivHash{'name'} . '\'',
2722,
);
return @emptyList;
}
# This call makes the original frame's textview scroll to the bottom, as it's
# supposed to
$axmud::CLIENT->desktopObj->updateWidgets(
$self->_objClass . '->processMxpFrameElement',
);
# Update IVs
$frameObj->ivPoke('tabObj', $tabObj);
$frameObj->ivPoke('paneObj', $tabObj->paneObj);
$frameObj->ivPoke('textViewObj', $tabObj->textViewObj);
}
# Close an existing frame, if specified
} elsif ($ivHash{'action'} eq 'close') {
# Do not close the default tab's pane object, even if the world wants to
# (The MXP spec doesn't specify what to do, but Axmud will not allow it)
if ($ivHash{'name'} eq '_top') {
$self->mxpDebug(
$origToken,
'Cannot close MXP frame corresponding to the default tab',
2723,
);
return @emptyList;
}
# Close the frame
if ($frameObj->internalFlag) {
# Remove an internal frame
$self->defaultTabObj->paneObj->stripObj->removeTableObj(
$self->defaultTabObj->paneObj,
);
} else {
# Halt the Frame task
$frameObj->taskObj->set_shutdownFlag(TRUE);
}
# Update IVs
$self->ivDelete('mxpFrameHash', $frameObj->name);
if ($self->mxpCurrentFrame eq $frameObj->name) {
# If the current frame is deleted, resume using the original frame
# (The MXP spec doesn't specify what to do, so Axmud will do this)
$self->ivPoke('mxpCurrentFrame', '_top');
$self->ivPoke('currentTabObj', $self->defaultTabObj);
}
if ($self->mxpPrevFrame eq $frameObj->name) {
# Same applies to the previous frame
$self->ivPoke('mxpPrevFrame', '_top');
}
}
# Redirect text received from the world to the frame
if ($ivHash{'action'} eq 'redirect') {
$self->ivPoke('mxpPrevFrame', $self->mxpCurrentFrame);
lib/Games/Axmud/Session.pm view on Meta::CPAN
# Check that the next token to process is an MXP token
$type = $self->ivFirst('currentTokenList');
if (defined $type && $type ne 'mxp') {
$self->mxpDebug('n/a', 'Temp secure mode not followed by an MXP tag', 5004);
# Disable temp secure mode
push (@tagList, $self->setMxpLineMode($self->mxpTempMode, TRUE));
$self->ivUndef('mxpTempMode');
}
}
return @tagList;
}
sub convertMxpWinSize {
# Called by $self->processMxpFrameElement
# When the world specifies a new frame using a <FRAME> tag, it can optionally specify the
# frame's size and position
# Work out the equivalent size and position on the workspace, in pixels
#
# Expected arguments
# $frameObj - The GA::Mxp::Frame object created in response to the <FRAME> tag
#
# Return values
# An empty list on improper arguments
# Otherwise, returns a list in the form (left, top, width, height)
# ...where 'left' and 'top' are the workspace coordinates of the top-left of the proposed
# window position, and 'width' / 'height' is the size of the window, all in pixels
my ($self, $frameObj, $check) = @_;
# Local variables
my (
$workspaceObj, $availableWidth, $availableHeight, $charWidth, $charHeight, $right,
$bottom,
@emptyList, @returnList,
);
# Check for improper arguments
if (! defined $frameObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->convertMxpWinSize', @_);
}
# The frame is opened in the same workspace used by the session's 'main' window
# The size of the available workspace is the current width and height, minus any space
# reserved for panels
$workspaceObj = $self->mainWin->workspaceObj;
$availableWidth = $workspaceObj->currentWidth - $workspaceObj->panelLeftSize
- $workspaceObj->panelRightSize;
$availableHeight = $workspaceObj->currentHeight - $workspaceObj->panelTopSize
- $workspaceObj->panelBottomSize;
# Get size of an 'X' character (because the MXP specification demands it)
($charWidth, $charHeight) = $self->currentTabObj->textViewObj->getCharSize('X');
# $frameObj->left (etc) can be in the form 'n%' (a percentage), 'nc' (a multiple of
# character widths/heights) or 'n' (a value in pixels), relative to the left or top of the
# available desktop
# A minus value, i.e. '-n%', '-nc' or '-n' signifies that the value is relative to the
# right or bottom of the available desktop
# If an invalid value was specified, use a default value
foreach my $iv ('left', 'top', 'width', 'height') {
my ($value, $minus, $num, $type, $newValue);
$value = $frameObj->$iv;
if ($value =~ m/(\-)?(\d+)([\%c]?)/) {
$minus = $1;
$num = $2;
$type = $3;
if (! $type) {
if ($iv eq 'left' || $iv eq 'width') {
if ($minus) {
$newValue = $availableWidth - $num;
} else {
$newValue = $num;
}
} else {
if ($minus) {
$newValue = $availableHeight - $num;
} else {
$newValue = $num;
}
}
} elsif ($type eq '%') {
if ($iv eq 'left' || $iv eq 'width') {
if ($minus) {
$newValue = $availableWidth - ($availableWidth * ($num / 100));
} else {
$newValue = $availableWidth * ($num / 100);
}
} else {
if ($minus) {
$newValue = $availableHeight - ($availableHeight * ($num / 100));
} else {
$newValue = $availableHeight * ($num / 100);
}
}
} elsif ($type eq 'c') {
if ($iv eq 'left' || $iv eq 'width') {
# (Take into account spacing around the grid window's strip and table
# objects by using $axmud::CLIENT->constGridSpacingPixels; it's not
# exact, but it's good enough)
$newValue = ($charWidth * $num) + $workspaceObj->controlsLeftSize
+ $workspaceObj->controlsRightSize
+ ($axmud::CLIENT->constGridSpacingPixels * 2);
if ($minus) {
$newValue = $availableWidth - $newValue;
}
} else {
$newValue = ($charHeight * $num) + $workspaceObj->controlsTopSize
+ $workspaceObj->controlsBottomSize
+ ($axmud::CLIENT->constGridSpacingPixels * 2);
if ($minus) {
$newValue = $availableHeight - $newValue;
}
}
}
} else {
# Invalid value, so use a default value
if ($iv eq 'left' || $iv eq 'top') {
$newValue = 0;
} elsif ($iv eq 'width') {
$newValue = int($availableWidth / 2);
} else {
$newValue = int($availableHeight / 2);
}
}
push (@returnList, $newValue);
}
# Sanity checking, for the benefit of an MXP frame tag which tries to draw a window outside
# the bounds of the desktop
# Left
if ($returnList[0] < 0) {
$returnList[0] = 0;
}
# Top
if ($returnList[1] < 0) {
$returnList[1] = 0;
}
# Width
$right = $returnList[0] + $returnList[2]; # left + width
if ($right > $availableWidth) {
$returnList[2] = $availableWidth - $returnList[0]; # total width - left
}
# Height
$bottom = $returnList[1] + $returnList[3]; # top + height
if ($bottom > $availableHeight) {
$returnList[3] = $availableHeight - $returnList[1]; # total height - top
}
return @returnList;
}
sub getMxpFrame {
# Can be called by anything
# Looks up the name of an MXP frame (implemented as a Frame task window) and returns the
# corresponding frame object
# The special name '_previous' refers to $self->mxpPrevFrame, a frame in $self->mxpFrameHash
# that could have any name, so all code should call this function rather than looking up a
# frame in $self->mxpFrameHash directly
#
# Expected arguments
# $name - An MXP frame name - one of the keys in $self->mxpFrameHash, or '_previous'
#
# Return values
# 'undef' on improper arguments or if the name doesn't match an MXP frame object
# Otherwise returns the matching MXP frame object
my ($self, $name, $check) = @_;
# Check for improper arguments
if (! defined $name || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->getMxpFrame', @_);
}
if ($name eq '_previous') {
return $self->ivShow('mxpFrameHash', $self->mxpPrevFrame);
} else {
return $self->ivShow('mxpFrameHash', $name);
}
}
lib/Games/Axmud/Session.pm view on Meta::CPAN
push (@modList, $self->ivShow('mxpGaugeHash', $name));
}
}
if (@modList) {
# The FALSE argument means 'don't keep an empty gauge level'
$self->mxpGaugeStripObj->removeGauges($self, FALSE, @modList);
foreach my $obj (@modList) {
$self->ivDelete('mxpGaugeHash', $obj->number);
}
if (! $self->mxpGaugeHash) {
# All gauges have been removed
$self->mxpGaugeStripObj->removeGaugeLevel($self, $self->mxpGaugeLevel);
$self->ivUndef('mxpGaugeLevel');
}
}
}
}
return 1;
}
sub mxpDoRelocate {
# Called by $self->incomingDataLoop
# Initiaties an MXP crosslinking operation. Closes the current connection and opens a new
# one
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->mxpDoRelocate', @_);
}
# If auto-saves are turned on, do an auto-save now
if ($axmud::CLIENT->autoSaveFlag && $self->autoSaveCheckTime) {
# Perform the auto-save
$self->pseudoCmd('save');
$self->ivPoke('autoSaveLastTime', $self->sessionTime);
# Set the time at which the next auto-save will occur
$self->resetAutoSave();
}
# Update the connection info strip object for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
$winObj->setHostLabel(
$self->getHostLabelText(),
'MXP crosslinking operation in progress...',
);
}
# Terminate the current connection
$self->doTempDisconnect();
$self->ivPoke('mxpRelocateMode', 'started');
# Make sure all changes are visible immediately
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->dispatchCmd');
# Intitiate the new connection
if (! $self->doConnect($self->mxpRelocateHost, $self->mxpRelocatePort, $self->protocol)) {
# Reconnection failed
$self->doDisconnect();
} else {
$self->ivPoke('mxpRelocateMode', 'wait_login');
}
return 1;
}
sub applyMxpFileFilter {
# Called by $self->processMxpImageElement and ->processMspSoundTrigger
# Given a full file path, applies the MXP file filter
# If the world has provided a plugin to convert an image/sound file its own format into a
# format supported by Axmud, call the plugin, which performs the conversion and returns
# the path to the converted file
#
# Expected arguments
# $path - Full file path to the image/sound file to convert, e.g.
# '/home/myname/axmud-data/deathmud/mxp/myimage.gff'
#
# Return values
# 'undef' on improper arguments or if the file can't be converted
# Otherwise returns the file path to the converted file (which the calling function will
# delete, after it's used), e.g. '/home/myname/axmud-data/deathmud/mxp/myimage.gif'
my ($self, $path, $check) = @_;
# Local variables
my ($file, $dir, $ext, $filterObj, $pluginObj, $funcRef);
# Check for improper arguments
if (! defined $path || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->applyMxpFileFilter', @_);
}
($file, $dir, $ext) = File::Basename::fileparse($path, qr/\.[^.]*/);
$ext =~ s/^\.//;
# Has the world specified a file filter for this file extension?
$filterObj = $self->ivShow('mxpFilterHash', $ext);
if (! defined $filterObj) {
# No file filter found, so ignore the file
return undef;
}
# Does the named plugin exist, and is it enabled?
$pluginObj = $axmud::CLIENT->ivShow('pluginHash', $filterObj->name);
if (! defined $pluginObj || ! $pluginObj->enabledFlag) {
# Plugin not available, so ignore the file
return undef;
lib/Games/Axmud/Session.pm view on Meta::CPAN
#
# Optional arguments
# @list - A list of values in the range 0-255 (can be an empty list)
#
# Return values
# An empty list on improper arguments
# Otherwise returns the modified list
my ($self, @list) = @_;
# Local variables
my @modList;
# (No improper arguments to check)
foreach my $value (@list) {
push (@modList, $value);
if ($value == 255) {
# Double escape this value
push (@modList, $value);
}
}
return @modList;
}
sub updateEcho {
# Called by $self->optCallback when the server requests that the client stop/resume ECHOing
# (also called by $self->disableTelnetOption)
# If this is the current session and the client is not ECHOing world commands, obscures text
# in the command entry box for any 'internal' windows used by this session
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $unobscureFlag - Set to TRUE when called by $self->doLogin, in which case we unobscure
# the command entry box, regardless of the setting of $self->echoMode
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $unobscureFlag, $check) = @_;
# Local variables
my @list;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->updateEcho', @_);
}
# Generate a list of this session's entry strip objects (the TRUE argument means 'only
# return 'internal' windows')
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if (
$stripObj
&& $stripObj->winObj->visibleSession
&& $stripObj->winObj->visibleSession eq $self
) {
push (@list, $stripObj);
}
}
foreach my $stripObj (@list) {
# (The server has suggested that the client stop ECHOing, and the client has agreed)
if ($self->echoMode eq 'client_agree' && ! $unobscureFlag) {
$stripObj->obscureEntry(TRUE);
# (The server has suggested that the client stop ECHOing, and the client has refused)
# (The server has suggested that the client resume ECHOing, and the client has agreed)
} else {
$stripObj->obscureEntry(FALSE);
}
}
# If the ECHO telnet option has been turned off and this session's special echo mode is
# enabled, disable it (extremely unlikely, but we'll check anyway)
if ($self->echoMode ne 'client_agree' && $self->specialEchoMode eq 'enabled') {
$self->ivPoke('specialEchoMode', 'disabled');
# Need to inform the strip objects. Can't incorporate this code into the foreach loop
# just above, because $unobscureFlag is a complicating factor
# (If the ECHO telnet option is turned back on at some later point, don't re-enable
# special echo mode. It's only enabled shortly after a login is completed)
foreach my $stripObj (@list) {
$stripObj->set_specialEchoFlag(FALSE);
}
}
return 1;
}
sub updateSpecialEcho {
# Called by $self->processIncomingData whenever there's a change in this session's special
# echo mode, in which case all strip entry objects (GA::Strip::Entry) must be informed
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->updateSpecialEcho', @_);
}
# (The TRUE argument means 'only return 'internal' windows)
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if ($stripObj) {
# Make sure the entry box is unobscured (assuming this session is the visible one,
# and that the world has actually turned on echo mode)
# visible one)
if (
$stripObj->winObj->visibleSession
&& $stripObj->winObj->visibleSession eq $self
&& $self->echoMode eq 'client_agree'
) {
$stripObj->obscureEntry(FALSE);
}
if ($self->specialEchoMode eq 'enabled') {
# Tell the strip entry object to start sending characters to the world, one at a
# time, as soon as they're typed (but only for world commands)
$stripObj->set_specialEchoFlag(TRUE);
} else {
# Tell the strip entry object to stop doing that
$stripObj->set_specialEchoFlag(FALSE);
}
}
}
return 1;
}
sub prepareTTypeData {
# Called by $self->optCallback when the server first requests TTYPE data
# Prepares (or resets) the items to be during TTYPE option sub-negotiations
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$termTypeMode, $customClientName, $customClientVersion, $useCtrlSeqFlag, $termType,
@termList, @itemList,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->prepareTTypeData', @_);
}
# Override GA::Client IVs, if necessary
if ($self->currentWorld->ivExists('termOverrideHash', 'termTypeMode')) {
lib/Games/Axmud/Session.pm view on Meta::CPAN
}
# Get the setting that applies - the override setting in the world profile, or the
# GA::Client setting
if ($self->status eq 'offline') {
# No visible cursors in offline mode - it looks bad
$cursorFlag = FALSE;
} elsif ($self->currentWorld->ivExists('termOverrideHash', 'useVisibleCursorFlag')) {
$cursorFlag = $self->currentWorld->ivShow('termOverrideHash', 'useVisibleCursorFlag');
} else {
$cursorFlag = $axmud::CLIENT->useVisibleCursorFlag;
}
# Update the default textview. Any other parts of the code which use cursors in their
# textview objects will have to make other arrangements
if ($self->defaultTabObj) {
$self->defaultTabObj->textViewObj->set_cursorEnableFlag($cursorFlag);
}
return 1;
}
sub textViewKeysUpdate {
# Called by GA::Client->toggle_termSetting, when the value stored in
# GA::Client->useDirectKeysFlag changes
# Also called by GA::EditWin::Profile::World->saveChanges when the override settings are
# modified
#
# Responds to the changed direct keys, disabling or enabling special echo mode
#
# Expected arguments
# (none besides $self)
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $check) = @_;
# Local variables
my (
$directFlag,
@list,
);
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->textViewKeysUpdate', @_);
}
# Generate a list of this session's entry strip objects (the TRUE argument means 'only
# return 'internal' windows')
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if (
$stripObj
&& $stripObj->winObj->visibleSession
&& $stripObj->winObj->visibleSession eq $self
) {
push (@list, $stripObj);
}
}
# Get the setting that applies - the override setting in the world profile, or the
# GA::Client setting
if ($self->currentWorld->ivExists('termOverrideHash', 'useDirectKeysFlag')) {
$directFlag = $self->currentWorld->ivShow('termOverrideHash', 'useDirectKeysFlag');
} else {
$directFlag = $axmud::CLIENT->useVisibleCursorFlag;
}
if (! $directFlag && $self->session->specialEchoMode eq 'enabled') {
$self->ivPoke('specialEchoMode', 'disabled');
foreach my $stripObj (@list) {
$stripObj->set_specialEchoFlag(FALSE);
}
} elsif ($directFlag && $self->session->specialEchoMode eq 'disabled') {
# Special echo mode can be reenabled, but only if it was disabled earlier in the
# session
$self->ivPoke('specialEchoMode', 'enabled');
foreach my $stripObj (@list) {
$stripObj->set_specialEchoFlag(TRUE);
}
}
return 1;
}
# Instructions
sub doInstruct {
# Executes an instruction (which could be a world command, a client command, a forced world
# command, an echo command, a Perl command, a script command, a multi command, a speedwalk
# command or a bypass command)
#
# Called by ->signal_connect in GA::Strip::Entry->setEntrySignals when the user types
# something in the 'main' window's command entry box and presses RETURN
# Also called by $self->perlCmd to deal with the return value of a Perl programme that's
# been executed
# Also called by $self->processLineSegment when an independent active trigger interface
# fires, which creates an instruction treated as if it had been typed by the user
# Also called by $self->checkHooks when an independent active hook interface fires, which
# creates an instruction treated as if it it had been typed by the user
# Also called by $self->checkTimers when an independent active timer interface fires, which
# creates an instruction treated as if it had been typed by the user
#
lib/Games/Axmud/Session.pm view on Meta::CPAN
} else {
return $self->writeError(
'Unrecognised client command \'' . $userCmd . '\'',
$self->_objClass . '->clientCmd',
);
}
} else {
# Get the corresponding standard (built-in) command
$standardCmd = $axmud::CLIENT->ivShow('userCmdHash', $userCmd);
}
# Check that a Perl object for this command actually exists (no reason why it shouldn't,
# but we'll check anyway)
if (! $axmud::CLIENT->ivExists('clientCmdHash', $standardCmd)) {
return $self->writeError(
'Missing client command \'' . $userCmd . '\' in registry',
$self->_objClass . '->clientCmd',
);
} else {
$cmdObj = $axmud::CLIENT->ivShow('clientCmdHash', $standardCmd);
}
# Many commands are not available after a disconnection (however, all commands are available
# in 'connect offline' mode)
if ($self->status eq 'disconnected' && ! $cmdObj->disconnectFlag) {
return $self->writeError(
'\'' . $standardCmd . '\' command unavailable while disconnected from the'
. ' world',
$self->_objClass . '->clientCmd',
);
}
# For commands whose ->noBracketFlag is TRUE, we have to re-parse $inputString, this time
# ignoring brackets (...) and diamond brackets <...>
if ($cmdObj->noBracketFlag) {
@inputWord = split(m/\s+/, $inputString);
}
# Replace the first word in @inputWord so that it's the standard (built-in) command, not the
# user command actually typed by the user
$inputWord[0] = $standardCmd;
# Call the corresponding command object's ->do function to execute the command
$result = $cmdObj->do($self, $inputString, $userCmd, @inputWord);
if (! $result) {
return undef;
} else {
# Sensitise/desensitise menu bar/toolbar items, depending on current conditions
$axmud::CLIENT->desktopObj->restrictWidgets();
# If the user typed a command like ';north portal' which was translated into
# ';allocateexit north portal', execute the corresponding world command
if ($worldCmd) {
$self->worldCmd($worldCmd);
}
return 1;
}
}
sub pseudoCmd {
# Can be called by any function which wants to execute a string as a client command, as if
# it has been typed in the 'main' window's command entry box
# e.g. The ';stopsession' command sometimes needs to call ';save'
# e.g. Axbasic scripts often need to execute strings as client commands
#
# This function allows the calling function to optionally specify whether the standard
# GA::Generic::Cmd->complete / ->error / ->improper messages should be displayed, or
# whether they should be suppressed
#
# Expected arguments
# $cmd - A string containing the pseudo command, e.g. 'setworld deathmud'. The first
# word should be a standard client command, not a user command (user commands
# will work, as long as they are still recognised, i.e. still exist in
# GA::Client->userCmdHash). The string should not begin with the client
# command sigil ';'
#
# Optional arguments
# $mode - Specifies how to display messages produced by client commands (does not affect
# how messages produced by Games::Axmud->writeText, ->writeDebug and so on are
# displayed)
# - The Axmud GUI and Automapper windows use modes 'win_error' and 'win_only'
# - Axbasic uses mode 'hide_complete'
#
# 'show_all' - show all standard messages produced by the command (with calls
# to GA::Generic::Cmd->complete, ->error and ->improper)
# 'hide_complete' - suppress messages produced by a call to
# GA::Generic::Cmd->complete (on the successful execution of a command),
# but display error messages
# 'hide_system' - suppress all standard messages produced by the command (with
# calls to GA::Generic::Cmd->complete, ->error and ->improper)
# 'win_error' - show messages produced by a call to GA::Generic::Cmd->complete
# (on the successful execution of a command) in the 'main' window, but
# show error message calls to ->error and ->improper in a 'dialogue'
# window
# 'win_only' suppress all messages produced by a call to
# GA::Generic::Cmd->complete (on the successful execution of a command),
# but show error message calls to ->error and ->improper in a 'dialogue'
# window
#
# Return values
# 'undef' on improper arguments or if an invalid $mode is specified
# Otherwise returns the result of the call to $self->clientCmd
my ($self, $cmd, $mode, $check) = @_;
lib/Games/Axmud/Session.pm view on Meta::CPAN
# If the connection is open, send the command to the world
if ($self->status eq 'connecting' || $self->status eq 'connected') {
# (Unless we're in the middle of a ';simulatecommand' operation)
if (! $self->disableWorldCmdFlag) {
# In special echo mode just send a newline character
if ($self->specialEchoMode eq 'enabled') {
$stripCmd = '';
# Telnet specifies that only US-ASCII is allowed. Filter out everything else
} elsif (
$self->sessionCharSet ne $axmud::CLIENT->constCharSet
&& $self->sessionCharSet ne 'null'
) {
# Exception - if using a non-standard character set, trust the Perl Encode
# module to take care of that stuff
$stripCmd = $encodeCmd;
} else {
$stripCmd = '';
foreach my $char (split(//, $cmd)) {
if (ord($char) >= 0 && ord($char) <= 127) {
$stripCmd .= $char;
}
}
}
# If MCP is enabled, in-band lines starting either '#$#' or '#$"' must be quoted,
# before being sent to the world
if (substr($stripCmd, 0, 3) eq '#$#' || substr($stripCmd, 0, 3) eq '#$"') {
# Quote the in-band line by preceding it with '#$"'
$stripCmd = '#$"' . $stripCmd;
}
# Send the command to the world
# Occasionally encounter an error in which this function was called to send a world
# command to a GA::Obj::Telnet object whose filehandle had just closed, so need
# to check for that
if (! $self->connectObj->eof()) {
$self->connectObj->print($stripCmd);
}
# Turn on the window blinker, and update IVs
$self->turnOnBlinker(2);
}
$self->ivIncrement('excessCmdCount');
# Fire any hooks that are using the 'send_cmd' hook event
$self->checkHooks('send_cmd', $cmd);
}
# Update the connection info strip object for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
# Update information stored in each 'internal' window's connection info strip, if
# visible
$winObj->setTimeLabel($self->getTimeLabelText());
}
# Convert text to speech, if required
if ($axmud::CLIENT->systemAllowTTSFlag && $axmud::CLIENT->ttsWorldCmdFlag) {
# Make sure the received text is visible in the 'main' window...
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->dispatchCmd');
# ...before converting text to speech
if (
$axmud::CLIENT->ttsVerboseFlag
&& defined $self->session->ttsLastType
&& $self->session->ttsLastType ne 'command'
) {
# Last TTS conversion was something other than a world command
$axmud::CLIENT->tts('Sent: ' . $cmd, 'command', 'command', $self);
} else {
# (Don't read out 'sent' again and again and again!
$axmud::CLIENT->tts($cmd, 'command', 'command', $self);
}
}
# Write to logs
$axmud::CLIENT->writeLog(
$self,
TRUE, # Not world-specific logs
$cmd,
FALSE, # Don't precede with a newline character
TRUE, # Use final newline character
'main', # Write to these files
);
return 1;
}
sub dispatchPassword {
# Called by $self->worldCmd
# Sends a command to the world which should be obscured in the current textview, because it
# contains a password. Unlike in a call to $self->dispatchCmd, the command is not recorded
# (if a recording is in progress), nor is it stored in any buffer or tested for aliases or
# hooks
# NB If $self->echoMode is set to 'client_agree', nothing is displayed in the 'main' window
# at all (as usual)
#
# Expected arguments
# $inputString - A string containing the whole world command, e.g. 'kill orc'
# $obscureString - A substring in $inputString. The substring is replaced in the 'main'
# window by asterisks, which obscures the password
#
# Return values
# 'undef' on improper arguments or if $inputString is an empty string
# 1 otherwise
my ($self, $inputString, $obscureString, $check) = @_;
# Local variables
my $bufferObj;
# Check for improper arguments
if (! defined $inputString || ! defined $obscureString || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->dispatchPassword', @_);
}
lib/Games/Axmud/Session.pm view on Meta::CPAN
}
# Obscure the command in the current textview (but if the server has suggested that the
# client stop ECHOing, and the client has agreed, don't show anything in the current
# textview)
if ($axmud::CLIENT->confirmWorldCmdFlag) {
if ($self->echoMode ne 'client_agree') {
$inputString =~ s/$obscureString/\*\*\*\*\*\*\*\*/g;
$self->currentTabObj->textViewObj->insertCmd($inputString);
} else {
# Officially, telnet clients are not supposed to insert a newline character when the
# server suggests the client stop ECHOing, and the client agrees. However, many
# worlds fail to supply their own newline character as they're supposed to. Set a
# flag that tells $self->processIncomingData to insert a newline character, if the
# packet it processes doesn't begin with one
$self->ivPoke('nlEchoFlag', TRUE);
}
} elsif ($self->promptFlag) {
# Sending a newline character cancel any prompt; even if the world command isn't
# explicitly echoed in the textview, the newline must be
$self->currentTabObj->textViewObj->insertCmd('');
}
# If $self->promptFlag is set, the most recently-received text is a command prompt
# A world command, displayed in the 'main' window's default textview, requires a newline
# character in that textview; but we only add a newline character to the received text
# (stored in the display buffer) if that received text ends in a command prompt
# (If we added a newline character all the time, a vital line in a room statement might be
# split in two, and then the Locator task won't be able to read it and the automapper will
# get lost)
# Exception - we don't insert a newline into the display buffer if echo mode is turned on;
# that's the world's responsibility
if ($self->promptFlag) {
$self->ivPoke('promptFlag', FALSE);
$self->ivPoke('promptInsertFlag', FALSE);
if ($self->displayBufferCount && $self->echoMode ne 'client_agree') {
$bufferObj = $self->ivShow('displayBufferHash', $self->displayBufferLast);
if ($bufferObj && ! $bufferObj->newLineFlag) {
$bufferObj->ivPoke('newLineFlag', TRUE);
}
}
}
# (Reset this IV in either case)
$self->ivUndef('promptCheckTime');
# Turn on the window blinker, and update IVs
$self->turnOnBlinker(2);
# Update the connection info strip object for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
# Update information stored in each 'internal' window's connection info strip, if
# visible
$winObj->setTimeLabel($self->getTimeLabelText());
}
# Convert text to speech, if required
if ($axmud::CLIENT->systemAllowTTSFlag && $axmud::CLIENT->ttsWorldCmdFlag) {
# Make sure the received text is visible in the 'main' window...
$axmud::CLIENT->desktopObj->updateWidgets($self->_objClass . '->dispatchPassword');
# ...before converting text to speech
$axmud::CLIENT->tts('Sent password', 'command', 'command', $self);
}
return 1;
}
sub checkRedirect {
# Called by $self->worldCmd to see whether a command should be processed in redirect mode.
# If so, processes the command; otherwise returns 'undef' so that the command can be
# processed as normal
# The calling function has already checked that redirect mode is on
#
# Expected arguments
# $cmd - The command to check
# $cage - The highest-priority command cage
#
# Return values
# 'undef' on improper arguments or if $cmd cannot be processed in redirect mode
# 1 if the $cmd is processed in redirect mode
my ($self, $cmd, $cage, $check) = @_;
# Local variables
my ($dirType, $flag, $redirectString, $bufferObj);
# Check for improper arguments
if (! defined $cmd || ! defined $cage || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->checkRedirect', @_);
}
# See if $cmd matches any recognised primary and/or secondary directions
$dirType = $self->currentDict->ivShow('combDirHash', $cmd);
# Redirect mode 'primary_only' - redirect primary directions
if (
$self->redirectMode eq 'primary_only'
&& defined $dirType
&& ($dirType eq 'primaryDir' || $dirType eq 'primaryAbbrev')
) {
$flag = TRUE;
# Redirect mode 'primary_secondary' - redirect primary and secondary directions (but not
# relative directions)
} elsif (
$self->redirectMode eq 'primary_secondary'
&& defined $dirType
&& $dirType ne 'relativeDir'
&& $dirType ne 'relativeAbbrev'
) {
$flag = TRUE;
# Redirect mode 'all_exits' - redirect primary and secondary directions, plus any command
# matching an exit in the current room (if set; actually the automapper's ->ghostRoom)
} elsif ($self->redirectMode eq 'all_exits') {
if (defined $dirType) {
lib/Games/Axmud/Session.pm view on Meta::CPAN
# F debug.protocol.msdp
# F debug.protocol.mxp
# F debug.protocol.mxp.comment
# F debug.protocol.pueblo
# F debug.protocol.peublo.comment
# F debug.line.numbers
# F debug.line.tags
# F debug.locator.some
# F debug.locator.all
# F debug.locator.exit
# F debug.locator.move
# F debug.obj.parse
# F debug.obj.compare
# F debug.error.plugin
# F debug.error.iv
# F debug.error.table
# F debug.error.trap
%clientHash = (
'debug.protocol.escape' => 'debugEscSequenceFlag',
'debug.protocol.telnet' => 'debugTelnetFlag',
'debug.protocol.telnet.short'
=> 'debugTelnetMiniFlag',
'debug.protocol.log' => 'debugTelnetLogFlag',
'debug.protocol.msdp' => 'debugMsdpFlag',
'debug.protocol.mxp' => 'debugMxpFlag',
'debug.protocol.mxp.comment'
=> 'debugMxpCommentFlag',
'debug.protocol.pueblo' => 'debugPuebloFlag',
'debug.protocol.pueblo.comment'
=> 'debugPuebloCommentFlag',
'debug.protocol.zmp' => 'debugZmpFlag',
'debug.protocol.atcp' => 'debugAtcpFlag',
'debug.protocol.gmcp' => 'debugGmcpFlag',
'debug.protocol.mcp' => 'debugMcpFlag',
'debug.line.numbers' => 'debugLineNumsFlag',
'debug.line.tags' => 'debugLineTagsFlag',
'debug.locator.some' => 'debugLocatorFlag',
'debug.locator.all' => 'debugMaxLocatorFlag',
'debug.locator.exit' => 'debugExitFlag',
'debug.locator.move' => 'debugMoveListFlag',
'debug.obj.parse' => 'debugParseObjFlag',
'debug.obj.compare' => 'debugCompareObjFlag',
'debug.error.plugin' => 'debugExplainPluginFlag',
'debug.error.iv' => 'debugCheckIVFlag',
'debug.error.table' => 'debugTableFitFlag',
'debug.error.trap' => 'debugTrapErrorFlag',
);
if (exists $clientHash{$string}) {
$blessed = $axmud::CLIENT;
$ivName = $clientHash{$string};
$var = $axmud::CLIENT->{$ivName};
$privFlag = TRUE;
} else {
$error = $genError;
}
} elsif ($first eq 'desktop') {
# S desktop.panel.left
# S desktop.panel.right
# S desktop.panel.top
# S desktop.panel.bottom
# S desktop.controls.left
# S desktop.controls.right
# S desktop.controls.top
# S desktop.controls.bottom
if (
$size != 3
|| ($second ne 'panel' && $second ne 'controls')
|| ($third ne 'left' && $third ne 'right' && $third ne 'top' && $third ne 'bottom')
) {
$error = $genError;
} else {
$blessed = $axmud::CLIENT;
if ($second eq 'panel') {
if ($third eq 'left') {
$ivName = 'customPanelLeftSize';
} elsif ($third eq 'right') {
$ivName = 'customPanelRightSize';
} elsif ($third eq 'top') {
$ivName = 'customPanelTopSize';
} elsif ($third eq 'bottom') {
$ivName = 'customPanelBottomSize';
}
} elsif ($second eq 'controls') {
if ($third eq 'left') {
$ivName = 'customControlsLeftSize';
} elsif ($third eq 'right') {
$ivName = 'customControlsRightSize';
} elsif ($third eq 'top') {
$ivName = 'customControlsTopSize';
} elsif ($third eq 'bottom') {
$ivName = 'customControlsBottomSize';
}
}
$var = $axmud::CLIENT->{$ivName};
$privFlag = TRUE;
}
} elsif ($first eq 'dict') {
# O dict.current
if ($second eq 'current') {
if ($size > 3) {
$error = $genError;
} elsif (! $self->currentDict) {
$error = 'No current dictionary set';
} else {
$blessed = $self->currentDict;
$privFlag = $blessed->_privFlag;
if (defined $third) {
$var = $blessed->{$last};
$ivName = $last;
lib/Games/Axmud/Session.pm view on Meta::CPAN
# S window.grid.height
# S window.text.size
# L window.charset.list
# S window.mode.tab
# F window.mode.xterm
# F window.mode.long
# F window.mode.simple
# F window.mode.toolbar
# F window.mode.irreversible
# F window.mode.urgency
# F window.mode.tooltip
# F window.confirm.close
# F window.confirm.tab
# F window.keys.scroll
# F window.keys.smooth
# F window.keys.split
# F window.keys.complete
# F window.keys.switch
%clientHash = (
'window.main.share' => 'shareMainWinFlag',
'window.main.width' => 'customMainWinWidth',
'window.main.height' => 'customMainWinHeight',
'window.grid.width' => 'customGridWinWidth',
'window.grid.height' => 'customGridWinHeight',
'window.text.size' => 'customTextBufferSize',
'window.charset.current'
=> 'charSet',
'window.charset.list' => 'charSetList',
'window.mode.tab' => 'sessionTabMode',
'window.mode.xterm' => 'xTermTitleFlag',
'window.mode.long' => 'longTabLabelFlag',
'window.mode.simple' => 'simpleTabFlag',
'window.mode.toolbar' => 'toolbarLabelFlag',
'window.mode.irreversible'
=> 'irreversibleIconFlag',
'window.mode.urgency' => 'mainWinUrgencyFlag',
'window.mode.tooltip' => 'mainWinTooltipFlag',
'window.confirm.close' => 'confirmCloseMainWinFlag',
'window.confirm.tab' => 'confirmCloseTabFlag',
'window.keys.scroll' => 'useScrollKeysFlag',
'window.keys.smooth' => 'smoothScrollKeysFlag',
'window.keys.split' => 'autoSplitKeysFlag',
'window.keys.complete' => 'useCompleteKeysFlag',
'window.keys.switch' => 'useSwitchKeysFlag',
);
if (exists $clientHash{$string}) {
$blessed = $axmud::CLIENT;
$ivName = $clientHash{$string};
$var = $axmud::CLIENT->{$ivName};
$privFlag = TRUE;
# O window.grid.NUMBER
} elsif ($second eq 'grid') {
if ($size < 3 || $size > 4) {
$error = $genError;
} elsif (! $axmud::CLIENT->desktopObj->ivExists('gridWinHash', $third)) {
if ($size == 3) {
$error = '\'Grid\' window \'' . $string . '\' doesn\'t exist';
} else {
$error = '\'Grid\' window \'' . $obj . '\' doesn\'t exist';
}
} else {
$blessed = $axmud::CLIENT->desktopObj->ivShow('gridWinHash', $third);
$privFlag = $blessed->_privFlag;
if (defined $fourth) {
$var = $blessed->{$last};
$ivName = $last;
} else {
$objFlag = TRUE;
}
}
# O window.free.NUMBER
} elsif ($second eq 'free') {
if ($size < 3 || $size > 4) {
$error = $genError;
} elsif (! $axmud::CLIENT->desktopObj->ivExists('freeWinHash', $third)) {
if ($size == 3) {
$error = '\'Free\' window \'' . $string . '\' doesn\'t exist';
} else {
$error = '\'Free\' window \'' . $obj . '\' doesn\'t exist';
}
} else {
$blessed = $axmud::CLIENT->desktopObj->ivShow('freeWinHash', $third);
$privFlag = $blessed->_privFlag;
if (defined $fourth) {
$var = $blessed->{$last};
$ivName = $last;
} else {
$objFlag = TRUE;
}
}
} else {
$error = $genError;
}
} elsif ($first eq 'winmap') {
my %clientHash;
# Save a lot of lines of code by loading IV names/values into hashes
# S winmap.default.enabled
# S winmap.default.disabled
# S winmap.default.internal
%clientHash = (
'winmap.default.enabled'
=> 'defaultEnabledWinmap',
'winmap.default.disabled'
=> 'defaultDisabledWinmap',
'winmap.default.internal'
=> 'defaultInternalWinmap',
);
if (exists $clientHash{$string}) {
$blessed = $axmud::CLIENT;
$ivName = $clientHash{$string};
$var = $axmud::CLIENT->{$ivName};
$privFlag = TRUE;
# O winmap.NAME
} else {
if ($size > 3) {
$error = $genError;
} elsif (! $axmud::CLIENT->ivExists('winmapHash', $second)) {
if ($size == 2) {
$error = 'Winmap \'' . $string . '\' doesn\'t exist';
} else {
$error = 'Winmap \'' . $obj . '\' doesn\'t exist';
}
} else {
$blessed = $axmud::CLIENT->ivShow('winmapHash', $second);
lib/Games/Axmud/Session.pm view on Meta::CPAN
'workspace.dir' => 'initWorkspaceDir',
'workspace.grid.activate'
=> 'activateGridFlag',
'workspace.grid.permit' => 'gridPermitFlag',
'workspace.grid.block' => 'gridBlockSize',
'workspace.grid.gap' => 'gridGapMaxSize',
'workspace.grid.adjust' => 'gridAdjustmentFlag',
'workspace.grid.correct'
=> 'gridEdgeCorrectionFlag',
'workspace.grid.reshuffle'
=> 'gridReshuffleFlag',
'workspace.grid.invisible'
=> 'gridInvisWinFlag',
);
if (exists $clientHash{$string}) {
$blessed = $axmud::CLIENT;
$ivName = $clientHash{$string};
$var = $axmud::CLIENT->{$ivName};
$privFlag = TRUE;
# S workspace.init.count
# S workspace.init.NUMBER
} elsif ($second eq 'init') {
if ($size != 3) {
$error = $genError;
} elsif ($third eq 'count') {
$blessed = undef;
$var = $axmud::CLIENT->ivPairs('initWorkspaceHash');
$ivName = 'initWorkspaceHash';
$privFlag = TRUE;
} elsif (! $axmud::CLIENT->ivExists('initWorkspaceHash', $third)) {
if ($size == 3) {
$error = 'Initial workspace \'' . $string . '\' doesn\'t exist';
} else {
$error = 'Initial workspace \'' . $obj . '\' doesn\'t exist';
}
} else {
$blessed = undef;
$var = $axmud::CLIENT->ivShow('initWorkspaceHash', $third);
$ivName = 'initWorkspaceHash';
$privFlag = TRUE;
}
# O workspace.obj.NUMBER
} elsif ($second eq 'obj') {
if ($size < 3 || $size > 4) {
$error = $genError;
} elsif (! $axmud::CLIENT->desktopObj->ivExists('workspaceHash', $third)) {
if ($size == 3) {
$error = 'Workspace object \'' . $string . '\' doesn\'t exist';
} else {
$error = 'Workspace object \'' . $obj . '\' doesn\'t exist';
}
} else {
$blessed = $axmud::CLIENT->desktopObj->ivShow('workspaceHash', $third);
$privFlag = $blessed->_privFlag;
if (defined $fourth) {
$var = $blessed->{$last};
$ivName = $last;
} else {
$objFlag = TRUE;
}
}
# O workspace.grid.NUMBER
} elsif ($second eq 'grid') {
if ($size < 3 || $size > 4) {
$error = $genError;
} elsif (! $axmud::CLIENT->desktopObj->ivExists('gridHash', $third)) {
if ($size == 3) {
$error = 'Workspace grid \'' . $string . '\' doesn\'t exist';
} else {
$error = 'Workspace grid \'' . $obj . '\' doesn\'t exist';
}
} else {
$blessed = $axmud::CLIENT->desktopObj->ivShow('gridHash', $third);
$privFlag = $blessed->_privFlag;
if (defined $fourth) {
$var = $blessed->{$last};
$ivName = $last;
} else {
$objFlag = TRUE;
}
}
} else {
$error = $genError;
}
} elsif ($first eq 'world') {
# o world.current
if ($second eq 'current') {
if ($size > 3) {
$error = $genError;
} elsif (! $self->currentWorld) {
$error = 'No current world profile set';
} else {
$blessed = $self->currentWorld;
$privFlag = $blessed->_privFlag;
if (defined $third) {
$var = $blessed->{$last};
$ivName = $last;
} else {
$objFlag = TRUE;
}
}
# L world.list.favourite
# L world.list.favorite
# L world.list.basic
} elsif ($second eq 'list') {
my @list;
if ($size != 3) {
$error = $genError;
} elsif ($third eq 'favourite' || $third eq 'favorite') {
$blessed = $axmud::CLIENT;
$var = $blessed->{favouriteWorldList};
lib/Games/Axmud/Session.pm view on Meta::CPAN
}
# Update the status task, if it's running
if ($self->statusTask) {
$self->statusTask->set_updateFlag(TRUE);
}
return 1;
}
sub add_systemMsg {
my ($self, $type, $msg, $check) = @_;
# Check for improper arguments
if (! defined $type || ! defined $msg || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->add_systemMsg', @_);
}
# If the Session Console window is actually open, display it there immediately
if ($self->consoleWin) {
$self->consoleWin->update($type, $msg);
} else {
$self->ivPush('systemMsgList', $type, $msg);
if ($type eq 'error' || $type eq 'warning' || $type eq 'improper') {
$self->ivPoke('systemMsgMode', 'error');
} elsif ($type eq 'debug' && $self->systemMsgMode ne 'error') {
$self->ivPoke('systemMsgMode', 'debug');
} elsif (
$type eq 'system'
&& $self->systemMsgMode ne 'error'
&& $self->systemMsgMode ne 'debug'
) {
$self->ivPoke('systemMsgMode', 'system');
}
# (The colour of the button, while flashing, might be different to the colour when it
# stops flashing)
if ($type eq 'error' || $type eq 'warning' || $type eq 'improper') {
$self->ivPoke('systemMsgTempMode', 'error');
} else {
$self->ivPoke('systemMsgTempMode', $type);
}
$self->ivPoke(
'systemMsgCheckTime',
($self->sessionTime + $self->systemMsgWaitTime),
);
# Update strip objects for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if ($stripObj) {
$stripObj->updateConsoleButton($self->systemMsgMode, $self->systemMsgTempMode);
}
}
}
return 1;
}
sub reset_systemMsg {
my ($self, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->reset_systemMsg', @_);
}
$self->ivEmpty('systemMsgList');
$self->ivPoke('systemMsgMode', 'empty');
$self->ivPoke('systemMsgTempMode', 'empty');
$self->ivUndef('systemMsgCheckTime');
# Update strip objects for any 'internal' windows used by this session
foreach my $winObj ($axmud::CLIENT->desktopObj->listSessionGridWins($self, TRUE)) {
my $stripObj = $winObj->ivShow('firstStripHash', 'Games::Axmud::Strip::Entry');
if ($stripObj) {
$stripObj->updateConsoleButton('empty');
}
}
return 1;
}
sub add_task {
my ($self, $taskObj, $check) = @_;
# Check for improper arguments
if (! defined $taskObj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->add_task', @_);
}
# Update IVs
$self->ivAdd('currentTaskHash', $taskObj->uniqueName, $taskObj);
$self->ivAdd('currentTaskNameHash', $taskObj->name, $taskObj);
return 1;
}
sub add_template {
my ($self, $obj, $check) = @_;
# Local variables
my @sessionList;
# Check for improper arguments
if (! defined $obj || defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->add_template', @_);
}
$self->ivAdd('templateHash', $obj->category, $obj);
# If any other sessions are using the same current world profile, update their IVs, too
@sessionList = $axmud::CLIENT->findSessions($self->currentWorld->name, $self);
foreach my $session (@sessionList) {
$session->ivAdd('templateHash', $obj->category, $obj);
}
# The data stored in this IV is saved in the 'otherprof' file
$self->setModifyFlag('otherprof', TRUE, $self->_objClass . '->add_template');
return 1;
}
sub del_template {
my ($self, $obj, $check) = @_;
( run in 1.010 second using v1.01-cache-2.11-cpan-f56aa216473 )