Acme-MUDLike
view release on metacpan or search on metacpan
lib/Acme/MUDLike.pm view on Meta::CPAN
my $pack = shift;
bless {
inventory => Acme::MUDLike::inventory->new,
messages => [ ],
@_,
}, $pack;
}
sub request :lvalue { $_[0]->{request} }
sub id { $_[0]->{name} eq $_[1] or $_[0] eq $_[1] }
sub name { $_[0]->{name} }
sub password { $_[0]->{password} }
sub x :lvalue { $_[0]->{x} }
sub y :lvalue { $_[0]->{y} }
sub xy { $_[0]->{x}, $_[0]->{y} }
sub get { 0; } # can't be picked up
sub inventory { $_[0]->{inventory} }
sub evalcode :lvalue { $_[0]->{evalcode } }
sub current_item :lvalue { $_[0]->{current_item} }
sub tell_object {
my $self = shift;
my $msg = shift;
push @{$self->{messages}}, $msg;
shift @{$self->{messages}} if @{$self->{messages}} > 100;
$got_message = 1; # XXX wish this didn't happen for each player but only once after all players got their message
}
sub get_html_messages {
my $self = shift;
return join "<br>\n", map { s{<}{\<}gs; s{\n}{<br>\n}g; $_ } $self->get_messages;
}
sub get_messages {
my $self = shift;
my @ret;
# this is written out long because I keep changing it around
for my $i (1..20) {
exists $self->{messages}->[-$i] or last;
my $msg = $self->{messages}->[-$i];
push @ret, $msg;
}
return reverse @ret;
}
sub header () { Acme::MUDLike::header() }
sub footer () { Acme::MUDLike::footer() }
sub command {
my $self = shift;
my $request = shift;
# this is called by login() immediately after verifying credientials
if($request->request->url->path =~ m/pushstream/) {
# warn "pushstream path_session handling XXX";
my $w = Coro::Event->var(var => \$got_message, poll => 'w');
while(1) {
$w->next;
# warn "got_message diddled XXX";
# on submitting the form without a JS background post, the poll HTTP connection gets broken
$SIG{PIPE} = 'IGNORE';
$request->print( join "<br>\n", map { s{<}{\<}gs; s{\n}{<br>\n}g; $_ } $self->get_messages );
$request->next;
}
}
if($request->request->url->path =~ m/sendmessage/) {
while(1) {
# warn "sendmessage path_session handling XXX";
my $msg = $request->param('message');
$self->parse_command($msg);
# $request->print("Got message.\n");
$request->print($self->get_html_messages());
$request->next;
}
}
#
# players get three execution contexts:
# * one for AJAX message posts without header/footer in the reply
# * one for COMET message pulls
# * the main HTML one below (which might only run once); arbitrarily selected as being the main one cuz its longest
#
$floor->insert($self);
while(1) {
$request->print(header);
#
# chat/commands
#
if($request->param('action') and $request->param('action') eq 'chat') {
# chat messages first so they appear in the log below
# there's only one action defined right now -- chat. everything else hangs off of that.
my $msg = $request->param('message');
$self->parse_command($msg);
};
do {
$request->print(qq{
<b>Chat/Command:</b>
<form method="post" id="f" action="/">
<input type="hidden" name="action" value="chat">
<input type="hidden" id="nick" name="nick" value="@{[ $self->name ]}">
<input type="hidden" id="admin" name="admin" value="$password">
<input type="text" id="message" name="message" size="50">
<!-- <input type="submit" name="sendbutton" value="Send" id="sendbutton"> -->
<input type="submit" name="sendbutton" value="Send" id="sendbutton">
<span id="status"></span>
</form>
<br>
<div id="log">@{[ $self->get_html_messages ]}</div>
});
};
} continue {
( run in 1.956 second using v1.01-cache-2.11-cpan-d8267643d1d )