lib/Frey/Mojo.pm

package Frey::Mojo;

use strict;
use warnings;

use base 'Mojo';

use MojoX::Dispatcher::Static;

use lib 'lib';
use Frey::Server;
use Frey::CouchAPI;

use Data::Dump qw/dump/;

__PACKAGE__->attr(
    static => (                             
        chained => 1,                       
        default => sub { MojoX::Dispatcher::Static->new }
    )
);

sub new {
    my $self = shift->SUPER::new();

    # This app should log only errors to STDERR
    $self->log->level('error');
    $self->log->path(undef);

#       warn "# home ", $self->home;

        $self->static->root( './' );

    return $self;
}


sub handler {
        my ($self, $tx) = @_;

        # XXX fake app so static dispatcher won't die on us
        {
                package Fake::App;
                use base 'Mojo::Transaction';
                sub app {
                        my $self = shift;
#                       warn "## $self app ", @_;
                        $self;
                }
                sub log {
                        my $self = shift;
#                       warn "## $self log ",@_;
                        return $self;
                }
                sub debug {
                        my $self = shift;
                        warn "## ",@_, $/;
                        return $self;
                }
        }
        bless $tx, 'Fake::App';

        # rewrite URL
        Frey::CouchAPI->rewrite_urls( $tx );

        if ( $self->static->dispatch($tx) ) {
#               warn "# static ",dump( $tx );
                return $tx;
        }

        my $body;

        my $server = Frey::Server->new;
        $server->{_print} = sub {
                $body .= join("\n", @_);
        };

        my $url = $tx->req->url->to_string;
        my $params = $tx->req->params->to_hash;

        my $referer = $tx->req->content->headers->header('Referer');
        my $ajax = $tx->req->content->headers->header('X-Requested-With');
        warn "# referer $referer\n";
        warn "# headers = ", dump( $tx->req->content->headers );

        if ( $referer =~ m{/_utils} || $ajax =~ m{XMLHttpRequest}i ) {
                return Frey::CouchAPI->dispatch( $tx );
        }

        warn "# url $url from $referer params ",dump($params);

        my $request = $server->request( $url, $params ); # fetch body

        warn "# request ", dump( $request );

        foreach ( 'content_type', 'code' ) {
                die "missing $_" unless defined $request->{$_};
        }

=for developer

        # compatiblity with unpatched Mojo
        sub class2rest {
                my $c = shift;
                $c =~ s/::/-/gs;
                $c;
        }
        $body =~ s{(/\w+::\w+[\w:]+)}{class2rest($1)}sge;

=cut

        $tx->res->code( $request->{code} );
        $tx->res->headers->content_type( $request->{content_type} );
        $tx->res->body( $body );

        warn dump( $tx->res->headers );
        return $tx;
}

1;
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	790	use lib 'lib';
11	dpavlin	633	use Frey::Server;
12	dpavlin	1046	use Frey::CouchAPI;
13	dpavlin	267
14	dpavlin	633	use Data::Dump qw/dump/;
15	dpavlin	267
16	dpavlin	633	__PACKAGE__->attr(
17			static => (
18			chained => 1,
19			default => sub { MojoX::Dispatcher::Static->new }
20			)
21			);
22
23			sub new {
24			my $self = shift->SUPER::new();
25
26			# This app should log only errors to STDERR
27			$self->log->level('error');
28			$self->log->path(undef);
29
30	dpavlin	1046	# warn "# home ", $self->home;
31	dpavlin	633
32			$self->static->root( './' );
33
34			return $self;
35	dpavlin	267	}
36
37	dpavlin	803
38	dpavlin	633	sub handler {
39			my ($self, $tx) = @_;
40	dpavlin	267
41	dpavlin	803	# XXX fake app so static dispatcher won't die on us
42			{
43			package Fake::App;
44			use base 'Mojo::Transaction';
45			sub app {
46			my $self = shift;
47	dpavlin	1046	# warn "## $self app ", @_;
48	dpavlin	803	$self;
49			}
50			sub log {
51			my $self = shift;
52	dpavlin	1046	# warn "## $self log ",@_;
53	dpavlin	803	return $self;
54			}
55			sub debug {
56			my $self = shift;
57	dpavlin	1046	warn "## ",@_, $/;
58	dpavlin	803	return $self;
59			}
60			}
61			bless $tx, 'Fake::App';
62
63	dpavlin	1046	# rewrite URL
64			Frey::CouchAPI->rewrite_urls( $tx );
65
66	dpavlin	633	if ( $self->static->dispatch($tx) ) {
67	dpavlin	636	# warn "# static ",dump( $tx );
68	dpavlin	633	return $tx;
69			}
70	dpavlin	267
71	dpavlin	633	my $body;
72	dpavlin	272
73	dpavlin	633	my $server = Frey::Server->new;
74			$server->{_print} = sub {
75			$body .= join("\n", @_);
76			};
77	dpavlin	272
78	dpavlin	633	my $url = $tx->req->url->to_string;
79	dpavlin	636	my $params = $tx->req->params->to_hash;
80	dpavlin	318
81	dpavlin	1046	my $referer = $tx->req->content->headers->header('Referer');
82			my $ajax = $tx->req->content->headers->header('X-Requested-With');
83			warn "# referer $referer\n";
84			warn "# headers = ", dump( $tx->req->content->headers );
85	dpavlin	318
86	dpavlin	1046	if ( $referer =~ m{/_utils} \|\| $ajax =~ m{XMLHttpRequest}i ) {
87			return Frey::CouchAPI->dispatch( $tx );
88			}
89
90			warn "# url $url from $referer params ",dump($params);
91
92	dpavlin	948	my $request = $server->request( $url, $params ); # fetch body
93	dpavlin	633
94	dpavlin	948	warn "# request ", dump( $request );
95
96			foreach ( 'content_type', 'code' ) {
97			die "missing $_" unless defined $request->{$_};
98			}
99
100	dpavlin	633	=for developer
101
102			# compatiblity with unpatched Mojo
103			sub class2rest {
104			my $c = shift;
105			$c =~ s/::/-/gs;
106			$c;
107			}
108			$body =~ s{(/\w+::\w+[\w:]+)}{class2rest($1)}sge;
109
110			=cut
111
112	dpavlin	948	$tx->res->code( $request->{code} );
113			$tx->res->headers->content_type( $request->{content_type} );
114	dpavlin	633	$tx->res->body( $body );
115
116			warn dump( $tx->res->headers );
117			return $tx;
118	dpavlin	267	}
119
120			1;