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';
with 'Frey::Path';

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 Data::Dump qw/dump/;
use HTML::ResolveLink;

sub path {
        my $self = shift;
        my $path = join('/', ( 'templates', $self->uri->host, $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 ) {

                $self->mkbasepath( $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 as_markup {
    my ( $self ) = @_;

        my $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,
                "\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;

        return $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	dpavlin	224	with 'Frey::Path';
16	dpavlin	195
17	dpavlin	164	has 'uri' => (
18			is => 'rw',
19	dpavlin	174	isa => 'Uri', coerce => 1,
20	dpavlin	164	required => 1,
21			);
22
23	dpavlin	166	has 'mirror' => (
24			is => 'rw',
25	dpavlin	195	isa => 'Bool',
26			default => 1,
27	dpavlin	166	);
28
29	dpavlin	196	has 'resolve_links' => (
30			is => 'rw',
31			isa => 'Bool',
32			default => 1,
33			);
34
35	dpavlin	164	#use String::TT qw/strip tt/;
36
37	dpavlin	195	#use pQuery;
38			use HTML::Query;
39	dpavlin	164	use File::Slurp;
40	dpavlin	196	use LWP::Simple qw/get/;
41	dpavlin	164	use Data::Dump qw/dump/;
42	dpavlin	196	use HTML::ResolveLink;
43	dpavlin	164
44	dpavlin	195	sub path {
45			my $self = shift;
46	dpavlin	203	my $path = join('/', ( 'templates', $self->uri->host, $self->uri->path ) );
47	dpavlin	195	$path .= '.html' if $path !~ m/\.\w+$/;
48			return $path;
49	dpavlin	164	}
50
51	dpavlin	195	sub get_page {
52			my ( $self ) = @_;
53	dpavlin	164
54	dpavlin	195	my $path = $self->path;
55	dpavlin	196	my $body;
56	dpavlin	166
57	dpavlin	195	if ( ! -e $path && $self->mirror ) {
58	dpavlin	166
59	dpavlin	224	$self->mkbasepath( $path );
60	dpavlin	164
61	dpavlin	195	my $url = $self->uri;
62			warn ">> mirror $url -> $path\n";
63	dpavlin	164
64	dpavlin	196	$body = get( $url ) or die "can't mirror $url: $!";
65
66			if ( $self->resolve_links ) {
67			my $resolver = HTML::ResolveLink->new( base => $url );
68			$body = $resolver->resolve( $body );
69			}
70
71			write_file( $path, $body );
72	dpavlin	195	warn "WW mirror $url -> $path ", -s $path, " bytes\n";
73	dpavlin	196
74			} else {
75			$body = read_file( $path );
76	dpavlin	195	}
77
78			warn "# $path ", -s $path, " == ", length($body), "bytes";
79			return $body;
80	dpavlin	164	}
81
82	dpavlin	455	sub as_markup {
83	dpavlin	319	my ( $self ) = @_;
84	dpavlin	164
85	dpavlin	201	my $body = $self->get_page;
86	dpavlin	164
87	dpavlin	195	# strip full hostname
88	dpavlin	164	my $url = $self->uri;
89	dpavlin	195	$body =~ s{\Q$url\E}{/}gs;
90			# remove cookie variable from url
91			$body =~ s{CARNetweb=[0-9a-f]+}{}gs;
92	dpavlin	164
93	dpavlin	195	=for pQuery
94	dpavlin	164
95	dpavlin	195	my $dom = pQuery( $body );
96			# warn dump( $dom->find("body") );
97			$dom->find(".navigation")->each( sub {
98			my $html = $_->innerHTML;
99			warn $html;
100			# $_->innerHTML(qq{
101			# <div style="border: 3px dashed black;">$html</div>
102			# });
103			} );
104	dpavlin	164
105	dpavlin	195	# $body = $dom->toHtml;
106	dpavlin	164
107	dpavlin	195	=cut
108	dpavlin	164
109	dpavlin	195	my $dom = HTML::Query->new(
110			text => $body,
111			'body',
112			);
113			# warn dump( $dom->as_HTML );
114	dpavlin	196	# $body = $dom->as_HTML->[0];
115	dpavlin	164
116	dpavlin	195	warn "<< ", $self->uri,
117			" ", -s $self->path,
118	dpavlin	166	"\n";
119	dpavlin	164
120			=for later
121
122			$body .= strip tt q{
123			<form method="post">
124			<input type="text" name="id" />
125			<input type="submit" />
126			</form>
127
128			<form method="post" enctype="multipart/form-data">
129			<input type="file" name="upload_file" />
130			<input type="submit" />
131			</form>
132
133			<pre>[% raw \| html %]</pre>
134			<pre>[% req_dump \| html %]</pre>
135			};
136
137			=cut
138
139	dpavlin	195	warn $body;
140
141	dpavlin	319	return $self->page( title => $self->uri, body => $body );
142	dpavlin	164	}
143
144			1;