lib/Frey/Mojo.pm

package Frey::Mojo;

use strict;
use warnings;

use base 'Mojo';

use MojoX::Dispatcher::Static;

use Frey::Server;

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) = @_;

        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;

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

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

=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(200);
        $tx->res->headers->content_type('text/html');
        $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	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	dpavlin	636	# warn "# static ",dump( $tx );
40	dpavlin	633	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	dpavlin	636	my $params = $tx->req->params->to_hash;
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;