view release on metacpan or  search on metacpan

lib/Acme/MUDLike.pm  view on Meta::CPAN

# player
#

package Acme::MUDLike::player;
push our @ISA, 'Acme::MUDLike::object';

sub player { 1 }
sub new {
    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{<}{\&lt;}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{<}{\&lt;}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">