1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
# A special restricted person that is used only before a user properly logs
# into the moo, to prompt for their login name and password.
package LoginPerson;
use strict;
use vars qw(@ISA);
use Thing;
use Verb;
use VerbCall;
use ThingList;
use Error;
use UNIVERSAL qw(isa);
@ISA=qw{Thing};
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
# I pass in all these values because LoginPeople arn't dumped out
# so they don't get any inheritance done on them, so we have to
# duplicate some data.
my $this = Thing::new($class,
# No reason to dump this type of object.
nodump => 1,
location => undef,
connected => undef,
output_callback => sub {},
close_callback => sub {},
fertile => undef,
# Remove all verbs already set.
verbs => {},
help_msg => "I don't understand that. Valid commands at this point are:\r\n\tconnect\r\n\tquit",
host => undef,
@_
);
$this->perms_r('output_callback',1);
$this->perms_r('close_callback',1);
$this->perms_r('host',1);
$this->addverb(Verb->new(
sub => 'verb_connect',
command => 'co*nnect',
direct_object => 'any',
preposition => 'any',
));
$this->addverb(Verb->new(
sub => 'verb_connect',
command => 'logi*n',
direct_object => 'any',
preposition => 'any',
));
$this->addverb(Verb->new(
sub => 'verb_logout',
command => 'logo*ut',
));
$this->addverb(Verb->new(
sub => 'verb_logout',
command => 'quit',
));
bless ($this, $class);
return $this;
}
# Outputs a collection of text to the user.
# Each seperate item is taken to be a new line.
sub tell {
my $this=shift;
foreach (@_) {
# Need to print out any errors that filtered down to here.
if (Error::iserror($_)) {
&{$this->output_callback}($_->message."\r\n");
}
elsif ($_) {
&{$this->output_callback}("$_\r\n");
}
}
}
# Takes a line of input from the remote user, parses it, and executes it.
sub parse {
my $this=shift;
my $line=shift;
$line=~s/[\r\n]//g; # have to handle both types of line endings.
my @words=Text::SplitWords($line);
my $verbcall=VerbCall->new();
$verbcall->caller($this);
$verbcall->words(@words);
$verbcall->command($line);
# Test for the verb being implmented, on this object only.
my $sub=$this->getverbsub($verbcall);
if (defined $sub) {
return $this->$sub($verbcall);
}
return Text::subst($this->help_msg);
}
# Override the location method so that whenever a loginperson moves somewhere,
# they are shown the new location.
sub location {
my $this=shift;
if (@_) {
my $newloc=shift;
if ($newloc && Thing::location($this) != $newloc) {
Thing::location($this,$newloc);
$this->tell($newloc->look);
}
}
return Thing::location($this);
}
# On logout, we delete outselves.
sub logout {
my $this=shift;
Utils::SuWizard(); # TODO: needed, but why?
$this->remove;
}
# This is responsible for authenticating the user into the moo.
sub verb_connect {
my $this=shift;
my $verbcall=shift;
# Figure out what person matches the name.
my @words=$verbcall->words;
my $user=ThingList::FindByName($words[1],"Person");
# Now ask the person if the provided credentials are sufficient for
# login.
if ($user && $user->login($this,@words)) {
# Now we're done - the login method of a person handles
# all the setup. All that's left to do is remove outselves.
$this->remove;
return;
}
else {
return Error->new("Login failure.");
}
}
# This disconnects them in case they changed their mind or something.
sub verb_logout {
my $this=shift;
my $verbcall=shift;
&{$this->close_callback};
# $this->location->contents_remove($this);
Utils::SuWizard(); # TODO: needed, but why?
$this->remove;
}
1
|
