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,
);

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

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

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

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;
        my $body;

        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";

                $body = get( $url ) or die "can't mirror $url: $!";

                if ( $self->resolve_links ) {
                        my $resolver = HTML::ResolveLink->new( base => $url );
                        $body = $resolver->resolve( $body );
                }

                write_file( $path, $body );
                warn "WW mirror $url -> $path ", -s $path, " bytes\n";

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