post results from the CPAN

Acme-MUDLike

view release on metacpan or search on metacpan


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')};
            $player->command($request); # doesn't return
        }
        # warn "trying login again XXX";
        $nick_tmp ||= ''; $admin_tmp ||= '';
        $nick_tmp =~ s/[^a-z]//gi; $admin_tmp =~ s/[^a-z0-9]//gi;
        $request->print(
            header, # $msg, 
            qq{
                <form method="post" action="/">
                    <input type="text" name="nick" value="$nick_tmp"> &lt;-- nickname<br>
                    <input type="password" name="admin" value="$admin_tmp"> &lt;-- admin password<br>
                    <input type="submit" value="Enter"><br>
                </form>
            },
            footer,
        );
        $request->next();
    }

}

#
# object
#

package Acme::MUDLike::object;

sub new { my $package = shift; bless { @_ }, $package; }
sub name :lvalue { $_[0]->{name} }
sub environment :lvalue { $_[0]->{environment} }
sub use { }
sub player { 0 }
sub desc { }
sub tell_object { }
sub get { 1 } # may be picked up
sub id { 0 }

#
# inventory
#

package Acme::MUDLike::inventory;

sub new { 
    # subclass this to build little container classes or create instances of it directly
    my $package = shift; bless [ ], $package; 
}

sub delete {
    my $self = shift;
    my $name = shift;
    for my $i (0..$#$self) {
        return splice @$self, $i, 1, () if $self->[$i]->id($name);
    }
}
sub insert {
    my $self = shift;
    my $ob = shift;
    UNIVERSAL::isa($ob, 'Acme::MUDLike::object') or Carp::confess('lit: ' . $ob . ' ref: ' . ref($ob));
    push @$self, $ob;
    $ob->environment = $self;
    $ob;
}
sub named {
    my $self = shift;
    my $name = shift;
    for my $i (@$self) {
        return $i if $i->id($name);
    }

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{<}{\&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">
                    <span id="status"></span>
                </form>
                <br>
                <div id="log">@{[ $self->get_html_messages ]}</div>
            });
        };

    } continue {
        $request->print(footer);
        $request->next();
    }  # end while
}

sub parse_command {
    my $self = shift;
    my $msg = shift;
warn "parse_command: msg: ``$msg''";
    $self->tell_object("> $msg");
    if($msg and $msg =~ m{^/}) {
        my @args = split / /, $msg;
        (my $cmd) = shift(@args) =~ m{/(\w+)};
        # XXX I'd like to see template matching, like V N A N, then preact/act/postact
        if( $self->can("_$cmd") ) {
            eval { $self->can("_$cmd")->($self, @args); 1; } or $self->tell_object("Error in command: ``$@''.");
        } else {
            $self->tell_object("No such command:  $cmd.");
        }
    } elsif($msg) {
        $floor->tell_object($self->name . ': ' . $msg); # XXX should be $self->environment->tell_object
        # $request->print("Got it!\n");
    }
}

sub item_by_arg {
    my $self = shift;
    my $item = shift;
    my $ob;
    return $self->current_item if $item eq 'current';
    if($item =~ m/^\d+$/) {
        my @stuff = $self->environment->contents;
        $ob = $stuff[$item] if $item < @stuff;
    }
    $ob or $ob = $self->inventory->named($item);      # thing in our inventory with that name
    $ob or $ob = $self->environment->named($item);     # thing in our environment with that name
    $ob or $ob = $item if exists &{$item.'::new'}; # raw package name
    $ob or do {
      # Foo::Bar=HASH(0x812ea54)
      my $hex;
      ($hex) = $item =~ m{^[a-z][a-z_:]+\((0x[0-9a-z]+)\)}i;
      $hex or ($hex) = $item =~ m{^0x([0-9a-z]+)}i;
      if($hex) {
          $ob = Devel::Pointer::deref(hex($hex));
      }
    };
    return $ob;
}

# actions

sub _call {
    my $self = shift;
    # XXX call a method an in object
    # XXX call sword name 
    my $item = shift;
    my $func = shift;
    my @args = @_; # XXX for each arg, go through the item finding code below, except keep identify if not found
    my $ob = $self->item_by_arg($item) or do {
        $self->tell_object("call: no item by that name/number/package name here");
        return;
    };
    for my $i (0..$#args) {
        my $x = $self->item_by_arg($args[$i]);
        $args[$i] = $x if $x;
    }
    $ob->can($func) or do {
        $self->tell_object("call:  item ``$item'' has no ``$func'' method");
        return;
    };
    $self->tell_object(join '', "Call: ", eval { $ob->can($func)->($ob, @args); } || "Error: ``$@''.");
    1;
}

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

					  .each( callback, [res.responseText, status, res] );
				else
					callback.apply( self, [res.responseText, status, res] );
			}
		});
		return this;
	},
	serialize: function() {
		return jQuery.param( this );
	},
	evalScripts: function() {
		return this.find("script").each(function(){
			if ( this.src )
				jQuery.getScript( this.src );
			else
				jQuery.globalEval( this.text || this.textContent || this.innerHTML || "" );
		}).end();
	}

});

// If IE is used, create a wrapper for the XMLHttpRequest object
if ( !window.XMLHttpRequest )
	XMLHttpRequest = function(){
		return new ActiveXObject("Microsoft.XMLHTTP");
	};

// Attach a bunch of functions for handling common AJAX events

jQuery.each( "ajaxStart,ajaxStop,ajaxComplete,ajaxError,ajaxSuccess,ajaxSend".split(","), function(i,o){
	jQuery.fn[o] = function(f){
		return this.bind(o, f);
	};
});

jQuery.extend({
	get: function( url, data, callback, type, ifModified ) {
		// shift arguments if data argument was ommited
		if ( jQuery.isFunction( data ) ) {
			callback = data;
			data = null;
		}
		
		return jQuery.ajax({
			url: url,
			data: data,
			success: callback,
			dataType: type,
			ifModified: ifModified
		});
	},
	getIfModified: function( url, data, callback, type ) {
		return jQuery.get(url, data, callback, type, 1);
	},
	getScript: function( url, callback ) {
		return jQuery.get(url, null, callback, "script");
	},
	getJSON: function( url, data, callback ) {
		return jQuery.get(url, data, callback, "json");
	},
	post: function( url, data, callback, type ) {
		if ( jQuery.isFunction( data ) ) {
			callback = data;
			data = {};
		}

		return jQuery.ajax({
			type: "POST",
			url: url,
			data: data,
			success: callback,
			dataType: type
		});
	},

	// timeout (ms)
	//timeout: 0,
	ajaxTimeout: function( timeout ) {
		jQuery.ajaxSettings.timeout = timeout;
	},
	ajaxSetup: function( settings ) {
		jQuery.extend( jQuery.ajaxSettings, settings );
	},

	ajaxSettings: {
		global: true,
		type: "GET",
		timeout: 0,
		contentType: "application/x-www-form-urlencoded",
		processData: true,
		async: true,
		data: null
	},
	
	// Last-Modified header cache for next request
	lastModified: {},
	ajax: function( s ) {
		// TODO introduce global settings, allowing the client to modify them for all requests, not only timeout
		s = jQuery.extend({}, jQuery.ajaxSettings, s);

		// if data available
		if ( s.data ) {
			// convert data if not already a string
			if (s.processData && typeof s.data != "string")
    			s.data = jQuery.param(s.data);
			// append data to url for get requests
			if( s.type.toLowerCase() == "get" ) {
				// "?" + data or "&" + data (in case there are already params)
				s.url += ((s.url.indexOf("?") > -1) ? "&" : "?") + s.data;
				// IE likes to send both get and post data, prevent this
				s.data = null;
			}
		}

		// Watch for a new set of requests
		if ( s.global && ! jQuery.active++ )
			jQuery.event.trigger( "ajaxStart" );

		var requestDone = false;

		// Create the request object
		var xml = new XMLHttpRequest();

		// Open the socket
		xml.open(s.type, s.url, s.async);

		// Set the correct header, if data is being sent
		if ( s.data )
			xml.setRequestHeader("Content-Type", s.contentType);

		// Set the If-Modified-Since header, if ifModified mode.
		if ( s.ifModified )
			xml.setRequestHeader("If-Modified-Since",
				jQuery.lastModified[s.url] || "Thu, 01 Jan 1970 00:00:00 GMT" );

		// Set header so the called script knows that it's an XMLHttpRequest
		xml.setRequestHeader("X-Requested-With", "XMLHttpRequest");

		// Make sure the browser sends the right content length
		if ( xml.overrideMimeType )
			xml.setRequestHeader("Connection", "close");
			
		// Allow custom headers/mimetypes
		if( s.beforeSend )
			s.beforeSend(xml);
			
		if ( s.global )
		    jQuery.event.trigger("ajaxSend", [xml, s]);

		// Wait for a response to come back
		var onreadystatechange = function(isTimeout){
			// The transfer is complete and the data is available, or the request timed out
			if ( xml && (xml.readyState == 4 || isTimeout == "timeout") ) {
				requestDone = true;
				
				// clear poll interval
				if (ival) {
					clearInterval(ival);
					ival = null;
				}
				
				var status;
				try {
					status = jQuery.httpSuccess( xml ) && isTimeout != "timeout" ?
						s.ifModified && jQuery.httpNotModified( xml, s.url ) ? "notmodified" : "success" : "error";
					// Make sure that the request was successful or notmodified
					if ( status != "error" ) {
						// Cache Last-Modified header, if ifModified mode.
						var modRes;
						try {

( run in 3.209 seconds using v1.01-cache-2.11-cpan-ceb78f64989 )