getpwuid results from the CPAN

Acme-MUDLike
view release on metacpan or search on metacpan
#   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;
    }

    #
    # login
    #

    while(1) {
        my $nick_tmp = $request->param('nick');
        my $admin_tmp = $request->param('admin');
        if(defined($nick_tmp) and defined($admin_tmp) and $nick_tmp =~ m/^[a-z]{2,20}$/i and $admin_tmp eq $password) {
            my $nick = $nick_tmp;
            $player = $players->named($nick) || $players->insert(Acme::MUDLike::player->new(name => $nick), );
            $player->request = $request;
            # @_ = ($player, $request,); goto &{Acme::MUDLike::player->can('command')};
( run in 1.343 second using v1.01-cache-2.11-cpan-5a3173703d6 )