lib/Frey/Designer.pm

package Frey::Designer;

use Moose;
use Frey::Types;
#use MooseX::Types::URI qw(Uri FileUri DataUri);

has 'uri' => (
        is => 'rw',
        isa => 'Uri', coerce => 1,
        required => 1,
);

has 'mirror' => (
        is => 'rw',
        isa => 'Boolean',
);

#use String::TT qw/strip tt/;

use pQuery;
use File::Slurp;
use LWP::Simple ();
use File::Path;
use Data::Dump qw/dump/;

sub template_path {
        return 'templates/www.carnet.hr/' . shift;
}

sub mirror_design {
        my ( $self, $c, $path ) = @_;
        return if -e $path;

        return unless $self->mirror;

        my $url = $self->uri . '/' . $c->req->path . '?' . $c->req->uri->query;

        my $base_path = $path;
        $base_path =~ s{/[^/]+$}{};
        mkpath $base_path if ! -e $base_path;

        warn ">> mirror $url -> $path\n";

        LWP::Simple::mirror( $url, $path ) or die "can't mirror $url: $!";
}

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

    my $req_dump = dump( $c->req );
    my $raw      = $c->req->raw_body;
    my $body;

        my $path = template_path( $c->req->path );

        if ( $path =~ m{/__bookmarklet} ) {
                $c->res->content_type( "text/html" );
                my $js = read_file( 'static/xpath.js' );
                $js =~ s{//.*}{}gm;     # remove comments so that compaction below doesn't screw code
                $js =~ s/\s\s+/ /gs;
        $c->res->body(qq{
                        drag this look to bookmark <a href="javascript:void($js);">xpath?</a> to install XPATH inspector
                        <p><a href="http://www.google.com/">link test</a>
                });
                return;
        }

        $path .= '.html' if $path !~ m/\.\w+$/;

        my $url = $self->uri;

        $self->mirror_design( $c, $path );

        $body .= read_file( $path );

        if ( $path =~ m/\.css$/ ) {
                $c->res->content_type( "text/css" );
        } elsif ( $path =~ m/\.(gif|jpe?g|png)$/ ) {
                my $type = $1;
                $type =~ s/jpg/jpeg/;
                $c->res->content_type( "image/$type" );
        } else {
                $c->res->content_type( "text/html" );

                # strip full hostname
                $body =~ s{\Q$url\E}{/}gs;
                # remove cookie variable from url
                $body =~ s{CARNetweb=[0-9a-f]+}{}gs;

                my $dom = pQuery( $body );
#               warn dump( $dom->find("body") );
                $dom->find(".navigation")->each( sub {
                        my $html = $_->innerHTML;
                        warn $html;
#                       $_->innerHTML(qq{
#                               <div style="border: 3px dashed black;">$html</div>
#                       });
                } );

#               $body = $dom->toHtml;

        }

        warn "<< ", $c->req->path,
                " ", -s $path,
                " ", $c->res->content_type,
                " ", $c->req->params ? dump( $c->req->params ) : '',
                "\n";

=for later

        $body .= strip tt q{ 
        <form method="post">
            <input type="text" name="id" />
            <input type="submit" />
        </form>

        <form method="post" enctype="multipart/form-data">
            <input type="file" name="upload_file" />
            <input type="submit" />
        </form>

        <pre>[% raw      | html %]</pre>
        <pre>[% req_dump | html %]</pre>
    };

=cut

    $c->res->body($body);
}

1;
1	dpavlin	164	package Frey::Designer;
2
3			use Moose;
4	dpavlin	174	use Frey::Types;
5			#use MooseX::Types::URI qw(Uri FileUri DataUri);
6	dpavlin	164
7			has 'uri' => (
8			is => 'rw',
9	dpavlin	174	isa => 'Uri', coerce => 1,
10	dpavlin	164	required => 1,
11			);
12
13	dpavlin	166	has 'mirror' => (
14			is => 'rw',
15			isa => 'Boolean',
16			);
17
18	dpavlin	164	#use String::TT qw/strip tt/;
19
20			use pQuery;
21			use File::Slurp;
22	dpavlin	166	use LWP::Simple ();
23	dpavlin	164	use File::Path;
24			use Data::Dump qw/dump/;
25
26			sub template_path {
27			return 'templates/www.carnet.hr/' . shift;
28			}
29
30			sub mirror_design {
31	dpavlin	166	my ( $self, $c, $path ) = @_;
32	dpavlin	164	return if -e $path;
33
34	dpavlin	166	return unless $self->mirror;
35
36			my $url = $self->uri . '/' . $c->req->path . '?' . $c->req->uri->query;
37
38	dpavlin	164	my $base_path = $path;
39			$base_path =~ s{/[^/]+$}{};
40			mkpath $base_path if ! -e $base_path;
41
42			warn ">> mirror $url -> $path\n";
43
44	dpavlin	166	LWP::Simple::mirror( $url, $path ) or die "can't mirror $url: $!";
45	dpavlin	164	}
46
47			sub handler {
48			my ( $self, $c ) = @_;
49
50			my $req_dump = dump( $c->req );
51			my $raw = $c->req->raw_body;
52			my $body;
53
54			my $path = template_path( $c->req->path );
55
56	dpavlin	175	if ( $path =~ m{/__bookmarklet} ) {
57			$c->res->content_type( "text/html" );
58			my $js = read_file( 'static/xpath.js' );
59			$js =~ s{//.*}{}gm; # remove comments so that compaction below doesn't screw code
60			$js =~ s/\s\s+/ /gs;
61			$c->res->body(qq{
62			drag this look to bookmark <a href="javascript:void($js);">xpath?</a> to install XPATH inspector
63			<p><a href="http://www.google.com/">link test</a>
64			});
65			return;
66			}
67
68	dpavlin	164	$path .= '.html' if $path !~ m/\.\w+$/;
69
70			my $url = $self->uri;
71
72	dpavlin	166	$self->mirror_design( $c, $path );
73	dpavlin	164
74			$body .= read_file( $path );
75
76			if ( $path =~ m/\.css$/ ) {
77			$c->res->content_type( "text/css" );
78			} elsif ( $path =~ m/\.(gif\|jpe?g\|png)$/ ) {
79			my $type = $1;
80			$type =~ s/jpg/jpeg/;
81			$c->res->content_type( "image/$type" );
82			} else {
83			$c->res->content_type( "text/html" );
84
85			# strip full hostname
86			$body =~ s{\Q$url\E}{/}gs;
87			# remove cookie variable from url
88			$body =~ s{CARNetweb=[0-9a-f]+}{}gs;
89
90			my $dom = pQuery( $body );
91			# warn dump( $dom->find("body") );
92			$dom->find(".navigation")->each( sub {
93	dpavlin	166	my $html = $_->innerHTML;
94			warn $html;
95			# $_->innerHTML(qq{
96			# <div style="border: 3px dashed black;">$html</div>
97			# });
98	dpavlin	164	} );
99
100	dpavlin	166	# $body = $dom->toHtml;
101
102	dpavlin	164	}
103
104	dpavlin	166	warn "<< ", $c->req->path,
105			" ", -s $path,
106			" ", $c->res->content_type,
107			" ", $c->req->params ? dump( $c->req->params ) : '',
108			"\n";
109	dpavlin	164
110			=for later
111
112			$body .= strip tt q{
113			<form method="post">
114			<input type="text" name="id" />
115			<input type="submit" />
116			</form>
117
118			<form method="post" enctype="multipart/form-data">
119			<input type="file" name="upload_file" />
120			<input type="submit" />
121			</form>
122
123			<pre>[% raw \| html %]</pre>
124			<pre>[% req_dump \| html %]</pre>
125			};
126
127			=cut
128
129			$c->res->body($body);
130			}
131
132			1;