Add ParrotLoaderPath configuration option, and debug for pudding

Configure.pl

@@ -44,7 +44,8 @@ sub write_definitions {
 my %config = (
 	LIBDIR => `parrot_config libdir`,
 	VERSIONDIR => `parrot_config versiondir`,
-	BUILD_DIR => `parrot_config build_dir`,
+	BUILDDIR => `parrot_config build_dir`,
+	INSTALLDIR => `$apxs -q LIBEXECDIR`,
 );
 
 chomp $config{$_} for (keys %config);

Makefile

@@ -5,3 +5,9 @@ all:
 clean:
 	make -C module clean
 	make -C loader clean
+
+debug:
+	@perl -Ipudding pudding/debug.pl
+
+test:
+	@perl -Ipudding pudding/test.pl

module/Makefile

@@ -1,15 +1,16 @@
+include ../config.mk
+
 SOURCE=mod_parrot.c mod_parrot_io.c mod_parrot_run.c
 MODULE=mod_parrot.la
+OUTPUT=../build/mod_parrot.so
 
-include ../config.mk
-
-mod_parrot.so:  $(MODULE) 
+$(OUTPUT):  $(MODULE) 
 	$(LIBTOOL) --mode=install cp mod_parrot.la $(BUILDDIR)/build
 
 $(MODULE): $(SOURCE)
 		$(APXS) $(FLAGS) -c $(SOURCE)
 
-%.c: mod_parrot.h
+$(SOURCE): mod_parrot.h config.h
 
 clean:
 	rm -rf .libs *.lo *.slo *.la *.o *.a *.pbc *.so

module/mod_parrot.c

@@ -1,27 +1,52 @@
 #include "mod_parrot.h"
 
+module mod_parrot;
+
 static int mod_parrot_handler(request_rec *req) {
 	Parrot_PMC interp;
-
+    /* TODO: do something more intelligent, i.e. figure out which
+     * request I want to handle compared to those I don't */
 	mod_parrot_interpreter(&interp);
 	mod_parrot_run(interp, req);
-	Parrot_api_destroy_interpreter(interp);
+	Parrot_api_destroy_interpreter(interp); 
 	return OK;
-
-	return DECLINED;
 }
 
 
+static void * mod_parrot_create_config(apr_pool_t * pool, server_rec * server) {
+    mod_parrot_conf * cfg = apr_pcalloc(pool, sizeof(mod_parrot_conf));
+    if (cfg) {
+        cfg->loaderPath = INSTALLDIR;
+    } 
+    return cfg;
+}
+
+static const char * mod_parrot_set_loader_path(cmd_parms *cmd, void * dummy, const char * arg) {
+    mod_parrot_conf * conf;
+    conf = ap_get_module_config(cmd->server->module_config, &mod_parrot);
+    if(conf) {
+        conf->loaderPath = arg;
+    } 
+    return NULL;
+}
+
 static void mod_parrot_register_hooks(apr_pool_t *p) {
 	ap_hook_handler(mod_parrot_handler, NULL, NULL, APR_HOOK_MIDDLE);
 }
 
-module AP_MODULE_DECLARE_DATA mod_parrot = {
+static command_rec mod_parrot_directives[] = {
+    AP_INIT_TAKE1("ParrotLoaderPath", mod_parrot_set_loader_path, NULL, RSRC_CONF, "Set the path for loader bytecodes"),
+    { NULL },
+};
+
+module mod_parrot = {
 	STANDARD20_MODULE_STUFF,
 	NULL,
 	NULL,
+	mod_parrot_create_config,
 	NULL,
-	NULL,
-	NULL, 
+	mod_parrot_directives, 
 	mod_parrot_register_hooks
 };
+
+

module/mod_parrot.h

@@ -20,3 +20,6 @@ void mod_parrot_interpreter(Parrot_PMC *interp);
 void mod_parrot_run(Parrot_PMC interp, request_rec *req);
 void mod_parrot_setup_args(Parrot_PMC interp, request_rec *req, Parrot_PMC *args);
 
+typedef struct {
+ const char * loaderPath;
+} mod_parrot_conf;

module/mod_parrot_run.c

@@ -65,12 +65,10 @@ void mod_parrot_setup_args(Parrot_PMC i, request_rec *req, Parrot_PMC *args) {
 	hash_set(i, *args, "SERVER_NAME", req->server->server_hostname);
 	hash_set(i, *args, "SERVER_PROTOCOL", req->protocol);
 
-
 	/* Network parameters. This should be simpler, but it isn't. */
 	hash_set(i, *args, "SERVER_ADDR", ipaddr(req->connection->local_addr));
 	hash_set(i, *args, "SERVER_PORT", apr_itoa(req->pool, req->connection->local_addr->port));
 
-
 	hash_set(i, *args, "REMOTE_ADDR", ipaddr(req->connection->remote_addr));
 	hash_set(i, *args, "REMOTE_PORT", apr_itoa(req->pool, req->connection->remote_addr->port));
 
@@ -86,41 +84,50 @@ void mod_parrot_setup_args(Parrot_PMC i, request_rec *req, Parrot_PMC *args) {
 			continue;
 		hash_set(i, *args, header_convert(req->pool, entries[idx].key), entries[idx].val);
 	}
-
 }
 
 void mod_parrot_interpreter(Parrot_PMC *interp) {
 	Parrot_PMC configHash, pir, pasm;
 	Parrot_api_make_interpreter(NULL, 0, NULL, interp);
 	configHash = new_instance(*interp, "Hash", NULL);
-	hash_set(*interp, configHash, "build_dir", BUILD_DIR);
+	hash_set(*interp, configHash, "build_dir", BUILDDIR);
 	hash_set(*interp, configHash, "versiondir", VERSIONDIR);
 	hash_set(*interp, configHash, "libdir", LIBDIR);
 	Parrot_api_set_configuration_hash(*interp, configHash);
 	imcc_get_pir_compreg_api(*interp, 1, &pir);
 	imcc_get_pasm_compreg_api(*interp, 1, &pasm);
 }
 
+extern module mod_parrot;
 
 void mod_parrot_run(Parrot_PMC i, request_rec *req) {
 	Parrot_PMC bytecodePMC, argumentsPMC;
 	Parrot_PMC inputPMC, outputPMC;
 	Parrot_PMC stdinPMC, stdoutPMC;
-	Parrot_String fileName;
+	Parrot_String fileNameStr;
+    char * filename;
+    mod_parrot_conf * conf = NULL;
+
+    /* setup input/output */
 	mod_parrot_io_new_input_handle(i, req, &inputPMC);
 	mod_parrot_io_new_output_handle(i, req, &outputPMC);
 	mod_parrot_io_read_input_handle(i, req, inputPMC);
 
-	mod_parrot_setup_args(i, req, &argumentsPMC);
-
 	Parrot_api_set_stdhandle(i, inputPMC, 0, &stdinPMC);
 	Parrot_api_set_stdhandle(i, outputPMC, 1, &stdoutPMC);
-
-	Parrot_api_string_import_ascii(i, "mod_parrot.pbc", &fileName);
-	Parrot_api_load_bytecode_file(i, fileName, &bytecodePMC);
 
+    conf = ap_get_module_config(req->server->module_config, &mod_parrot);
+    if(conf) {
+        filename = apr_pstrcat(req->pool, conf->loaderPath, "/", "mod_parrot.pbc", NULL);
+    } else {
+        filename = apr_pstrcat(req->pool, INSTALLDIR, "/", "mod_parrot.pbc", NULL);
+    }
+    ap_rputs(filename, req);
+    /* initialize the loader script */
+    Parrot_api_string_import_ascii(i, filename, &fileNameStr);
+    Parrot_api_load_bytecode_file(i, fileNameStr, &bytecodePMC);
+    /* setup arguments to the loader */
+    mod_parrot_setup_args(i, req, &argumentsPMC);
     Parrot_api_run_bytecode(i, bytecodePMC, argumentsPMC);
-	mod_parrot_io_write_output_handle(i, req, outputPMC);
-
-
+    mod_parrot_io_write_output_handle(i, req, outputPMC);
 }

pudding/Client.pm

@@ -27,7 +27,7 @@ sub url {
 
 sub is_get {
 	my ($self, $uri, $exp) = @_;
-    $self->{http}->get(url(@_))->{content} eq $exp;
+    print $self->{http}->get(url(@_))->{content};
 }
 
 sub is_ok {

pudding/Server.pm

@@ -8,6 +8,8 @@ use File::Basename;
 use File::Slurp;
 use File::Path qw/make_path/;
 use File::Temp qw/tempfile tempdir/;
+use Data::Dumper;
+use Carp;
 
 =head1 Apache as an object.
 
@@ -28,9 +30,7 @@ sub writeconf {
     }
 
     if(ref (my $options = $conf{Options}) eq 'HASH') {
-        print $out '<Location "/">';
         print $out $_, $conf{Options}->{$_} for keys(%$options);
-        print $out '</Location>';
     }
 
 	close $out;
@@ -66,7 +66,7 @@ sub new {
         PidFile => $directory . '/httpd.pid',
         DocumentRoot => $directory . '/docs',
         ErrorLog => $directory . '/error.log',
-        Listen => 8000,
+        Listen => 8000 + @servers,
     }, $class;
 }
 
@@ -125,7 +125,17 @@ sub serve {
     }
 }
 
+=head2 Debug a server using gdb
 
+=cut
+
+sub debug {
+    my $self = shift;
+	make_path($self->{DocumentRoot}) unless -d $self->{DocumentRoot};
+    $self->{File} = writeconf(%$self);
+    exec("gdb", "--args", $self->{Process}, "-d", $self->{ServerRoot},
+         "-f", $self->{File}, "-X");
+}
 
 =head2 Stop the web server.
 

pudding/provish.pl → pudding/debug.pl

@@ -26,13 +26,5 @@
     ;
 
 $server->loadModule( mod_parrot => $config::BUILDDIR . '/build/mod_parrot.so');
-
-$server->start();
-
-$server->serve('index.html', $doc);
-
-my $client = Client->new($server);
-$client->is_ok('index.html') or carp('index does not exist');
-$client->is_get('index.html', $doc) or carp('doc looks different');
-$client->is_status('foobar.html', 404) or carp('there is a foobar.html');
-$server->stop();
+$server->configure( ParrotLoaderPath => $config::BUILDDIR . '/build/');
+$server->debug(); # this ends the script and starts gdb. You should have gdb.

pudding/test.pl

@@ -0,0 +1,8 @@
+#! perl
+
+use Server;
+use Client;
+use Test::More;
+
+
+