png results from the CPAN

Acme-MUDLike
view release on metacpan or search on metacpan
#   lib for people to play around in.
# 
# * Acme::IRCLike would probably be more popular -- bolt an IRC server onto your app.
# 
# * Also, a telnet interface beyond just an HTTP interface would be nice.  Should be easy to do.
# 
# * Let "players" wander between apps.  Offer RPC to support this.
# 
# * Optionally take an existing Continuity instance with path_session set and optionally parameters
#   for the paths to use for chat pull and commands.
#   Not sure how to work this; each path gets its own coroutine, but there is still only one main().
#   Continuity doesn't have a registry of which paths go to which callbacks.
# 
# Done:
# 
# * mark/call commands should have a current object register, so you can do /call thingie whatever /next and then be calling 
#   into the object returned by thingie->whatever
# 
# * /list (like look, but with stringified object references)
# 
# * /mark <n>  ... or... /mark <stringified obj ref>
# 
# * messages still in duplicate when the same player logs in twice; make room's tell_object operate uniquely.
# 
# * messages in triplicate because each player has three routines and is inserted into the floor three times.  oops.
# 
# * build the ajax.chat.js into source. -- okay, test.
# 
# * eval, call
# 
# * inventory's insert() method should set the insertee's environment to itself.  that way, all objects have an environment.
# 
# * Commands need to do $floor->tell_object or $self->tell_object rather than output directly.
# 
# * Put @messages into the room ($floor).  Get the chat action out of the main loop.  Dispatch all
#   actions.  Maybe.
# 

our $password; # Acme::State friendly
our $floor;    # holds all other objects
our $players;  # holds all players; kind of like $floor except in the future, inactive players might get removed from the floor, or there might be multiple rooms

my $continuity;
my $got_message;   # diddled to wake the chat event watchers

$SIG{PIPE} = 'IGNORE';

sub new {
    my $package = shift;
    my %args = @_;

    die "We've already got one" if $continuity;

    $password = delete $args{password} if exists $args{password};
    $password ||= join('', map { $_->[int rand scalar @$_] } (['a'..'z', 'A'..'Z', '0'..'9']) x 8),

    my $staticp = sub { 
        # warn "staticp: url->path: ``@{[ $_[0]->url->path ]}''"; 
        return 0 if $_[0]->url->path =~  m/\.js$/; 
        # warn "staticp: dynamic js handling override not engaged";
        return $_[0]->url->path =~ m/\.(jpg|jpeg|gif|png|css|ico|js)$/ 
    };

    $continuity = $args{continuity} || Continuity->new(
        staticp => sub { $staticp->(@_); },
        callback => sub { login(@_) },
        path_session => 1,
        port => 2000,
        %args,
    );

    print "Admin:\n", $continuity->adapter->daemon->url, '?admin=', $password, '&nick=', (getpwuid $<)[0], "\n";

    $floor ||= Acme::MUDLike::room->new();
    $players ||= Acme::MUDLike::inventory->new();

    bless { }, $package;
}

sub loop { my $self = shift; $continuity->loop(@_); }

sub header {
    qq{
        <html><head>
            <script src="/jquery.js" type="text/javascript"></script>
            <script src="/chat.js" type="text/javascript"></script>
        </head><body>
    }; 
}

sub footer { qq{</body></html>\n}; }

sub login {

    my $request = shift;

    #
    # per-user variables
    #

    my $player;

    # STDERR->print("debug: " . $request->request->url->path . "\n"); # XXX
    # STDERR->print("debug: " . $request->request->as_string . "\n"); # XXX
    $SIG{PIPE} = 'IGNORE'; # XXX not helping at all.  grr.

    #
    # static files
    #

    if($request->request->url->path eq '/chat.js') {
        # warn "handling chat.js XXX: ". $request->request->url->path;
        $request->print(Acme::MUDLike::data->chat_js());
        return;
    } elsif($request->request->url->path eq '/jquery.js') {
        # warn "handling jquery.js XXX: ". $request->request->url->path;
        $request->print(Acme::MUDLike::data->jquery());
        return;
    }

    #
( run in 3.214 seconds using v1.01-cache-2.11-cpan-df04353d9ac )