/[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 1168 by dpavlin, Thu Jul 2 21:55:44 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 $path = $tx->req->url->path;
90            if ( $path =~ m{/($rewrite_regex)} ) {
91                    my $from = $1;
92                    my $to = $mapping_url->{$from} || return tx_die( $tx, 500, "Unknown $from" );
93                    $tx->req->url->path( $to );
94                    warn "ACL $from -> $to OK\n";
95            } else {
96                    return tx_die( $tx, 404, "Noting at $path") if ! $ENV{FREY_DEV};
97            }
98    
99          my $body;          my $body;
100    
101          my $server = Frey::Server->new;          my $server = Frey::Server->new;
# Line 71  sub handler { Line 103  sub handler {
103                  $body .= join("\n", @_);                  $body .= join("\n", @_);
104          };          };
105    
106          my $url = $tx->req->url->to_string;          my $url = $tx->req->url->to_abs->to_string;
107          my $params = $tx->req->params->to_hash;          my $params = $tx->req->params->to_hash;
108    
109          warn "# url $url params ",dump($params);          my $referer = $tx->req->content->headers->header('Referer');
110            my $ajax = $tx->req->content->headers->header('X-Requested-With');
111            warn "# referer $referer\n";
112    #       warn "## headers = ", dump( $tx->req->content->headers );
113    
114            if ( $referer =~ m{/_utils} || $ajax =~ m{XMLHttpRequest}i ) {
115                    return Frey::CouchAPI->dispatch( $tx ) if $couch_api;
116            }
117    
118            warn "# url $url from $referer params ",dump($params);
119    
120          my $content_type = $server->request( $url, $params ); # fetch body          my $request = $server->request( $url, $params ); # fetch body
121    
122            warn "# request ", dump( $request );
123    
124            foreach ( 'content_type', 'code' ) {
125                    die "missing $_" unless defined $request->{$_};
126            }
127    
128  =for developer  =for developer
129    
# Line 90  sub handler { Line 137  sub handler {
137    
138  =cut  =cut
139    
140          $tx->res->code(200);          $tx->res->code( $request->{code} );
141          $tx->res->headers->content_type( $content_type );          $tx->res->headers->content_type( $request->{content_type} );
142          $tx->res->body( $body );          $tx->res->body( $body );
143    
144          warn dump( $tx->res->headers );          warn dump( $tx->res->headers );
Legend:
Removed from v.803  
changed lines
  Added in v.1168
  ViewVC Help
Powered by ViewVC 1.1.26