/[Frey]/trunk/lib/Frey/Mojo.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/lib/Frey/Mojo.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 633 - (hide annotations)
Sun Nov 30 01:46:13 2008 UTC (15 years, 5 months ago) by dpavlin
File size: 1275 byte(s)
work on Mojo server which is now partially supported
(form post doesn't seem to work yet)

This implementation is based on Mojo instead of Mojolicious
removing bunch of code and complications, so it will probably
become default once fixed
1 dpavlin 267 package Frey::Mojo;
2    
3     use strict;
4     use warnings;
5    
6 dpavlin 633 use base 'Mojo';
7 dpavlin 267
8 dpavlin 633 use MojoX::Dispatcher::Static;
9 dpavlin 267
10 dpavlin 633 use Frey::Server;
11 dpavlin 267
12 dpavlin 633 use Data::Dump qw/dump/;
13 dpavlin 267
14 dpavlin 633 __PACKAGE__->attr(
15     static => (
16     chained => 1,
17     default => sub { MojoX::Dispatcher::Static->new }
18     )
19     );
20    
21     sub new {
22     my $self = shift->SUPER::new();
23    
24     # This app should log only errors to STDERR
25     $self->log->level('error');
26     $self->log->path(undef);
27    
28     warn "# home ", $self->home;
29    
30     $self->static->root( './' );
31    
32     return $self;
33 dpavlin 267 }
34    
35 dpavlin 633 sub handler {
36     my ($self, $tx) = @_;
37 dpavlin 267
38 dpavlin 633 if ( $self->static->dispatch($tx) ) {
39     warn "# static ",dump( $tx );
40     return $tx;
41     }
42 dpavlin 267
43 dpavlin 633 my $body;
44 dpavlin 272
45 dpavlin 633 my $server = Frey::Server->new;
46     $server->{_print} = sub {
47     $body .= join("\n", @_);
48     };
49 dpavlin 272
50 dpavlin 633 my $url = $tx->req->url->to_string;
51     my $params = $tx->req->params;
52 dpavlin 318
53 dpavlin 633 warn "# url $url params ",dump($params);
54 dpavlin 318
55 dpavlin 633 $server->request( $url, $params ); # fetch body
56    
57     =for developer
58    
59     # compatiblity with unpatched Mojo
60     sub class2rest {
61     my $c = shift;
62     $c =~ s/::/-/gs;
63     $c;
64     }
65     $body =~ s{(/\w+::\w+[\w:]+)}{class2rest($1)}sge;
66    
67     =cut
68    
69     $tx->res->code(200);
70     $tx->res->headers->content_type('text/html');
71     $tx->res->body( $body );
72    
73     warn dump( $tx->res->headers );
74     return $tx;
75 dpavlin 267 }
76    
77     1;

  ViewVC Help
Powered by ViewVC 1.1.26