/[Frey]/branches/zimbardo/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

Diff of /branches/zimbardo/lib/Frey/Mojo.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 267 by dpavlin, Wed Nov 5 08:20:37 2008 UTC revision 1169 by dpavlin, Thu Jul 2 22:22:20 2009 UTC
# Line 3  package Frey::Mojo; Line 3  package Frey::Mojo;
3  use strict;  use strict;
4  use warnings;  use warnings;
5    
6  use base 'Mojolicious';  use base 'Mojo';
7    
8  # This method will run for each request  use MojoX::Dispatcher::Static;
9  sub dispatch {  use Data::Dump qw/dump/;
10      my ($self, $c) = @_;  
11    use lib 'lib';
12      # Try to find a static file  use Frey::Server;
13      $self->static->dispatch($c);  
14    use Frey::CouchAPI;
15      # Use routes if we don't have a response code yet  my $couch_api = 0;
16      $self->routes->dispatch($c) unless $c->res->code;  
17    # FIXME move this somewhere
18      # Nothing found  use App::RoomReservation;
19      unless ($c->res->code) {  my $mapping_url;
20          $self->static->serve($c, '/404.html');  my $url_mapping = App::RoomReservation->url_mapping;
21          $c->res->code(404);  map { $mapping_url->{ $url_mapping->{$_} } = $_ } keys %$url_mapping;
22      }  my $rewrite_regex = join('|', sort { length $b <=> length $a } keys %$mapping_url);
23    warn "# mapping $rewrite_regex ",dump( $mapping_url );
24    
25    
26    __PACKAGE__->attr(
27        static => (                            
28            chained => 1,                      
29            default => sub { MojoX::Dispatcher::Static->new }
30        )
31    );
32    
33    sub new {
34        my $self = shift->SUPER::new();
35    
36        # This app should log only errors to STDERR
37        $self->log->level('error');
38        $self->log->path(undef);
39    
40    #       warn "# home ", $self->home;
41    
42            $self->static->root( './' );
43    
44        return $self;
45  }  }
46    
47  # This method will run once at server start  sub tx_die {
48  sub startup {          my $tx = shift;
49      my $self = shift;          $tx->res->code( shift );
50            $tx->res->body( shift );
51      # The routes          $tx->res->headers->content_type( shift || 'text/plain' );
52      my $r = $self->routes;          return $tx;
53    }
54      # Default route  
55      $r->route('/:controller/:action/:id')  sub handler {
56        ->to(controller => 'example', action => 'welcome', id => 1);          my ($self, $tx) = @_;
57    
58            # XXX fake app so static dispatcher won't die on us
59            {
60                    package Fake::App;
61                    use base 'Mojo::Transaction';
62                    sub app {
63                            my $self = shift;
64    #                       warn "## $self app ", @_;
65                            $self;
66                    }
67                    sub log {
68                            my $self = shift;
69    #                       warn "## $self log ",@_;
70                            return $self;
71                    }
72                    sub debug {
73                            my $self = shift;
74                            warn "## ",@_, $/;
75                            return $self;
76                    }
77            }
78            bless $tx, 'Fake::App';
79    
80            # rewrite URL
81            Frey::CouchAPI->rewrite_urls( $tx ) if $couch_api;
82    
83            if ( ! $self->static->dispatch($tx) ) {
84    #               warn "# static ",dump( $tx );
85                    return $tx;
86            }
87    
88            # FIXME this should move somewhere
89            my $url = $tx->req->url->to_abs->to_string;
90            if ( $url =~ m{/($rewrite_regex)} ) {
91                    my $from = $1;
92                    my $to = $mapping_url->{$from} || return tx_die( $tx, 500, "Unknown $from" );
93    
94                    $url =~ s{/($from)}{/$to};
95    
96                    $tx->req->url( Mojo::URL->new($url) );
97                    warn "ACL $from -> $to OK\n";
98            } else {
99                    return tx_die( $tx, 404, "Noting at $url") if ! $ENV{FREY_DEV};
100            }
101    
102            my $body;
103    
104            my $server = Frey::Server->new;
105            $server->{_print} = sub {
106                    $body .= join("\n", @_);
107            };
108    
109            my $params = $tx->req->params->to_hash;
110    
111            my $referer = $tx->req->content->headers->header('Referer');
112            my $ajax = $tx->req->content->headers->header('X-Requested-With');
113            warn "# referer $referer\n";
114    #       warn "## headers = ", dump( $tx->req->content->headers );
115    
116            if ( $referer =~ m{/_utils} || $ajax =~ m{XMLHttpRequest}i ) {
117                    return Frey::CouchAPI->dispatch( $tx ) if $couch_api;
118            }
119    
120            warn "# url $url from $referer params ",dump($params);
121    
122            my $request = $server->request( $url, $params ); # fetch body
123    
124            warn "# request ", dump( $request );
125    
126            foreach ( 'content_type', 'code' ) {
127                    die "missing $_" unless defined $request->{$_};
128            }
129    
130    =for developer
131    
132            # compatiblity with unpatched Mojo
133            sub class2rest {
134                    my $c = shift;
135                    $c =~ s/::/-/gs;
136                    $c;
137            }
138            $body =~ s{(/\w+::\w+[\w:]+)}{class2rest($1)}sge;
139    
140    =cut
141    
142            $tx->res->code( $request->{code} );
143            $tx->res->headers->content_type( $request->{content_type} );
144            $tx->res->body( $body );
145    
146            warn dump( $tx->res->headers );
147            return $tx;
148  }  }
149    
150  1;  1;
Legend:
Removed from v.267  
changed lines
  Added in v.1169
  ViewVC Help
Powered by ViewVC 1.1.26