/[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

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

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

revision 803 by dpavlin, Wed Dec 10 22:44:52 2008 UTC revision 1169 by dpavlin, Thu Jul 2 22:22:20 2009 UTC
# Line 6  use warnings; Line 6  use warnings;
6  use base 'Mojo';  use base 'Mojo';
7    
8  use MojoX::Dispatcher::Static;  use MojoX::Dispatcher::Static;
9    use Data::Dump qw/dump/;
10    
11  use lib 'lib';  use lib 'lib';
12  use Frey::Server;  use Frey::Server;
13    
14  use Data::Dump qw/dump/;  use Frey::CouchAPI;
15    my $couch_api = 0;
16    
17    # FIXME move this somewhere
18    use App::RoomReservation;
19    my $mapping_url;
20    my $url_mapping = App::RoomReservation->url_mapping;
21    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(  __PACKAGE__->attr(
27      static => (                                  static => (                            
# Line 26  sub new { Line 37  sub new {
37      $self->log->level('error');      $self->log->level('error');
38      $self->log->path(undef);      $self->log->path(undef);
39    
40          warn "# home ", $self->home;  #       warn "# home ", $self->home;
41    
42          $self->static->root( './' );          $self->static->root( './' );
43    
44      return $self;      return $self;
45  }  }
46    
47    sub tx_die {
48            my $tx = shift;
49            $tx->res->code( shift );
50            $tx->res->body( shift );
51            $tx->res->headers->content_type( shift || 'text/plain' );
52            return $tx;
53    }
54    
55  sub handler {  sub handler {
56          my ($self, $tx) = @_;          my ($self, $tx) = @_;
# Line 43  sub handler { Line 61  sub handler {
61                  use base 'Mojo::Transaction';                  use base 'Mojo::Transaction';
62                  sub app {                  sub app {
63                          my $self = shift;                          my $self = shift;
64                          warn "## $self app ", @_;  #                       warn "## $self app ", @_;
65                          $self;                          $self;
66                  }                  }
67                  sub log {                  sub log {
68                          my $self = shift;                          my $self = shift;
69                          warn "## $self log ",@_;  #                       warn "## $self log ",@_;
70                          return $self;                          return $self;
71                  }                  }
72                  sub debug {                  sub debug {
73                          my $self = shift;                          my $self = shift;
74                          warn "## $self debug ",@_;                          warn "## ",@_, $/;
75                          return $self;                          return $self;
76                  }                  }
77          }          }
78          bless $tx, 'Fake::App';          bless $tx, 'Fake::App';
79    
80          if ( $self->static->dispatch($tx) ) {          # rewrite URL
81            Frey::CouchAPI->rewrite_urls( $tx ) if $couch_api;
82    
83            if ( ! $self->static->dispatch($tx) ) {
84  #               warn "# static ",dump( $tx );  #               warn "# static ",dump( $tx );
85                  return $tx;                  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;          my $body;
103    
104          my $server = Frey::Server->new;          my $server = Frey::Server->new;
# Line 71  sub handler { Line 106  sub handler {
106                  $body .= join("\n", @_);                  $body .= join("\n", @_);
107          };          };
108    
         my $url = $tx->req->url->to_string;  
109          my $params = $tx->req->params->to_hash;          my $params = $tx->req->params->to_hash;
110    
111          warn "# url $url params ",dump($params);          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 $content_type = $server->request( $url, $params ); # fetch body          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  =for developer
131    
# Line 90  sub handler { Line 139  sub handler {
139    
140  =cut  =cut
141    
142          $tx->res->code(200);          $tx->res->code( $request->{code} );
143          $tx->res->headers->content_type( $content_type );          $tx->res->headers->content_type( $request->{content_type} );
144          $tx->res->body( $body );          $tx->res->body( $body );
145    
146          warn dump( $tx->res->headers );          warn dump( $tx->res->headers );
Legend:
Removed from v.803  
changed lines
  Added in v.1169
  ViewVC Help
Powered by ViewVC 1.1.26