lib/Frey/Designer.pm

package Frey::Designer;
use Moose;

=head1 NAME

Frey::Designer - modify html (sometime in future)

=cut

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

extends 'Frey';
with 'Frey::Web';

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

has 'mirror' => (
        is => 'rw',
        isa => 'Bool',
        default => 1,
);

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

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

sub path {
        my $self = shift;
        my $path = 'templates/www.carnet.hr/' . $self->uri->path;
        $path .= '.html' if $path !~ m/\.\w+$/;
        return $path;
}

sub get_page {
        my ( $self ) = @_;

        my $path = $self->path;

        if ( ! -e $path && $self->mirror ) {

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

                my $url = $self->uri;
                warn ">> mirror $url -> $path\n";

                LWP::Simple::mirror( $url, $path ) or die "can't mirror $url: $!";
                warn "WW mirror $url -> $path ", -s $path, " bytes\n";
        }

        my $body = read_file( $path );
        warn "# $path ", -s $path, " == ", length($body), "bytes";
        return $body;
}

sub html {
    my ( $self, $req ) = @_;

    my $body;

        if ( $self->uri->path =~ m{/__bookmarklet} ) {
                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;
        $req->print(qq{
                        Drag this <a href="javascript:void($js);">bookmarklet</a> to bookmark toolbar or menu to install XPATH inspector
                });
                return;
        }

        $body .= $self->get_page;

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

=for pQuery

        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;

=cut

        my $dom = HTML::Query->new(
                text => $body,
                'body',
        );
#       warn dump( $dom->as_HTML );
        $body = $dom->as_HTML->[0];

        warn "<< ", $self->uri,
                " ", -s $self->path,
                " ", $req->params ? dump( $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

        warn $body;

        $req->print( $self->page( title => $self->uri, body => $body ) );
}

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