text but no images

lib/WebGUI.pm

@@ -156,10 +156,15 @@ The Apache2::RequestRec object passed in by Apache's mod_perl.
 =cut
 
 sub handler {
-	my $request = shift;	#start with apache request object
+    my $request = shift; # either apache request object or PSGI env hash
-    $request = Apache2::Request->new($request);
+    my $server;
+    if ($request->isa('WebGUI::Session::Plack')) {
+        $server  = $request->server;
+    } else {
+        $request = Apache2::Request->new($request);
+        $server  = Apache2::ServerUtil->server;	#instantiate the server api
+    }
 	my $configFile = shift || $request->dir_config('WebguiConfig'); #either we got a config file, or we'll build it from the request object's settings
-	my $server = Apache2::ServerUtil->server;	#instantiate the server api
 	my $config = WebGUI::Config->new($server->dir_config('WebguiRoot'), $configFile); #instantiate the config object
     my $error = "";
     my $matchUri = $request->uri;
@@ -168,15 +173,15 @@ sub handler {
 	my $gotMatch = 0;
 
     # handle basic auth
-    my $auth = $request->headers_in->{'Authorization'};
+#    my $auth = $request->headers_in->{'Authorization'};
-    if ($auth =~ m/^Basic/) { # machine oriented
+#    if ($auth =~ m/^Basic/) { # machine oriented
-	    # Get username and password from Apache and hand over to authen
+#	    # Get username and password from Apache and hand over to authen
-        $auth =~ s/Basic //;
+#        $auth =~ s/Basic //;
-        authen($request, split(":", MIME::Base64::decode_base64($auth), 2), $config); 
+#        authen($request, split(":", MIME::Base64::decode_base64($auth), 2), $config); 
-    }
+#    }
-    else { # realm oriented
+#    else { # realm oriented
-	    $request->push_handlers(PerlAuthenHandler => sub { return WebGUI::authen($request, undef, undef, $config)});
+#	    $request->push_handlers(PerlAuthenHandler => sub { return WebGUI::authen($request, undef, undef, $config)});
-    }
+#    }
 
 	
 	# url handlers
@@ -208,55 +213,15 @@ sub handler {
 }
 
 sub handle_psgi {
-    my $env     = shift; # instead of an Apache2::Request object
+    my $env = shift;
     require WebGUI::Session::Plack;
-    my $plack   = WebGUI::Session::Plack->new( env => $env );
+    my $plack = WebGUI::Session::Plack->new( env => $env );
-    my $server  = $plack->server;
-    my $config  = WebGUI::Config->new( $env->{'wg.WEBGUI_ROOT'}, $env->{'wg.WEBGUI_CONFIG'} );
-    my $error    = "";
-    my $matchUri = $plack->uri;
-    my $gateway  = $config->get("gateway");
-    $matchUri =~ s{^$gateway}{/};
     
-#    # handle basic auth
+    # returns something like Apache2::Const::OK, which we ignore
-#    my $auth = $plack->headers_in->{'Authorization'};
+    my $ret = handler($plack);
-#    if ($auth =~ m/^Basic/) { # machine oriented
-#	    # Get username and password from Apache and hand over to authen
-#        $auth =~ s/Basic //;
-#        authen($plack, split(":", MIME::Base64::decode_base64($auth), 2), $config); 
-#    }
-#    else { # realm oriented
-#	    $plack->push_handlers(PerlAuthenHandler => sub { return WebGUI::authen($plack, undef, undef, $config)});
-#    }
     
-    
+    # let Plack::Response do its thing
-    # url handlers
+    return $plack->finalize;
-    # TODO: We should probably ditch URL Handlers altogether in favour of Plack::Middleware
-    WEBGUI_FATAL: foreach my $handler ( @{ $config->get("urlHandlers") } ) {
-        my ($regex) = keys %{$handler};
-        if ( $matchUri =~ m{$regex}i ) {
-            my $output = eval { WebGUI::Pluggable::run( $handler->{$regex}, "handler", [ $plack, $server, $config ] ) };
-            if ($@) {
-                $error = $@;
-                last;
-            }
-#            else {
-#				$gotMatch = 1;
-#				if ($output ne Apache2::Const::DECLINED) {
-#					return $output;
-#				}
-#            }
-            return $output if $output;
-        }
-    }
-#    return Apache2::Const::DECLINED if ($gotMatch);
-
-    # can't handle the url due to error or misconfiguration
-    return [
-        500,
-        [ 'Content-Type' => 'text/html' ],
-        ["This server is unable to handle the url '$matchUri' that you requested. $error"]
-    ];
 }
 
 1;

lib/WebGUI/Session/Http.pm

@@ -389,6 +389,16 @@ sub setCookie {
 	$ttl = (defined $ttl ? $ttl : '+10y');
 
 	if ($self->session->request) {
+	    if ($self->session->request->isa('WebGUI::Session::Plack')) {
+	        $self->session->request->response->cookies->{$name} = {
+	            value => $value,
+                path => '/',
+                expires => $ttl ne 'session' ? $ttl : undef,
+                domain => $domain,
+            };
+            return;
+	    }
+	    
 		require Apache2::Cookie;
 		my $cookie = Apache2::Cookie->new($self->session->request,
 			-name=>$name,

lib/WebGUI/Session/Plack.pm

@@ -21,13 +21,17 @@ sub new {
     my $request = Plack::Request->new( $p{env} );
     my $response = $request->new_response;
     
-    bless {
+    my $self = bless {
         %p,
         pnotes => {},
         request => $request,
         response => $response,
         server => WebGUI::Session::Plack::Server->new( env => $p{env} ),
     }, $class;
+    
+    $self->{headers_out} = WebGUI::Session::Plack::HeadersOut->new( plack => $self );
+    
+    return $self;
 }
 
 sub session { $_[0]{session} }
@@ -43,18 +47,28 @@ sub AUTOLOAD {
     my $what = $AUTOLOAD;
     $what =~ s/.*:://;
     
-    warn "!!plack->$what(@_)";
+    carp "!!plack->$what(@_)";
 }
 
 sub uri { shift->request->request_uri(@_) }
-sub headers_in { shift->request->headers(@_) }
 sub param { shift->request->param(@_) }
 sub params { shift->request->params(@_) }
+sub headers_in { shift->request->headers(@_) }
+sub headers_out { shift->{headers_out} }
+sub protocol { shift->request->protocol(@_) }
+sub status { shift->response->status(@_) }
+sub status_line {}
 
 # TODO: I suppose this should do some sort of IO::Handle thing
 my @body;
 sub print { shift; push @body, @_ }
 
+sub dir_config {
+    my $self = shift;
+    my $c = shift;
+    return $self->env->{"wg.DIR_CONFIG.$c"};
+}
+
 sub pnotes {
     my ($self, $key) = (shift, shift);
     return wantarray ? %{$self->{pnotes}} : $self->{pnotes} unless defined $key;
@@ -62,12 +76,36 @@ sub pnotes {
     return $self->{pnotes}{$key};
 }
 
+sub user {
+    my ($self, $user) = @_;
+    if (defined $user) {
+        $self->{user} = $user;
+    }
+    $self->{user};
+}
+
 sub push_handlers {
     my $self = shift;
     my ($x, $sub) = @_;
-    carp "push_handlers on $x";
+    
-    return $sub->();
+    # log it
+    carp "push_handlers($x)";
+    
+    # run it 
+    # returns something like Apache2::Const::OK, which we just ignore because we're not modperl
+    my $ret = $sub->($self);
+    
+    return;
 }
+
+sub finalize {
+    my $self = shift;
+    $self->response->body(\@body);
+    return $self->response->finalize;
+}
+
+sub content_type { shift->response->content_type(@_) }
+
 #
 #sub headers_in {
 #    my $self = shift;
@@ -79,6 +117,7 @@ package WebGUI::Session::Plack::Server;
 
 use strict;
 use warnings;
+use Carp;
 
 sub new {
     my $class = shift;
@@ -93,7 +132,7 @@ sub AUTOLOAD {
     my $what = $AUTOLOAD;
     $what =~ s/.*:://;
     
-    warn "!!server->$what(@_)";
+    carp "!!server->$what(@_)";
     return;
 }
 
@@ -103,6 +142,29 @@ sub dir_config {
     return $self->env->{"wg.DIR_CONFIG.$c"};
 }
 
+package WebGUI::Session::Plack::HeadersOut;
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+    my $class = shift;
+    bless { @_ }, $class;
+}
+
+our $AUTOLOAD;
+sub AUTOLOAD {
+    my $self = shift;
+    my $what = $AUTOLOAD;
+    $what =~ s/.*:://;
+    
+    carp "!!headers_out->$what(@_)";
+    return;
+}
+
+sub set { shift->{plack}->response->headers->header(@_) }
+
 # --
 
 ## CGI request are _always_ main, and there is never a previous or a next