/[Frey]/branches/no-pager/lib/Frey/Designer.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /branches/no-pager/lib/Frey/Designer.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 196 - (hide annotations)
Tue Oct 28 19:34:10 2008 UTC (15 years, 6 months ago) by dpavlin
Original Path: trunk/lib/Frey/Designer.pm
File size: 3010 byte(s)
resolve links in page to original content using HTML::ResolveLink
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 196 has 'resolve_links' => (
29     is => 'rw',
30     isa => 'Bool',
31     default => 1,
32     );
33    
34 dpavlin 164 #use String::TT qw/strip tt/;
35    
36 dpavlin 195 #use pQuery;
37     use HTML::Query;
38 dpavlin 164 use File::Slurp;
39 dpavlin 196 use LWP::Simple qw/get/;
40 dpavlin 164 use File::Path;
41     use Data::Dump qw/dump/;
42 dpavlin 196 use HTML::ResolveLink;
43 dpavlin 164
44 dpavlin 195 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 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 195 my $base_path = $path;
60     $base_path =~ s{/[^/]+$}{};
61     mkpath $base_path if ! -e $base_path;
62 dpavlin 164
63 dpavlin 195 my $url = $self->uri;
64     warn ">> mirror $url -> $path\n";
65 dpavlin 164
66 dpavlin 196 $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 dpavlin 195 warn "WW mirror $url -> $path ", -s $path, " bytes\n";
75 dpavlin 196
76     } else {
77     $body = read_file( $path );
78 dpavlin 195 }
79    
80     warn "# $path ", -s $path, " == ", length($body), "bytes";
81     return $body;
82 dpavlin 164 }
83    
84 dpavlin 195 sub html {
85     my ( $self, $req ) = @_;
86 dpavlin 164
87     my $body;
88    
89 dpavlin 195 if ( $self->uri->path =~ m{/__bookmarklet} ) {
90 dpavlin 175 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 dpavlin 195 $req->print(qq{
94     Drag this <a href="javascript:void($js);">bookmarklet</a> to bookmark toolbar or menu to install XPATH inspector
95 dpavlin 175 });
96     return;
97     }
98    
99 dpavlin 195 $body .= $self->get_page;
100 dpavlin 164
101 dpavlin 195 # strip full hostname
102 dpavlin 164 my $url = $self->uri;
103 dpavlin 195 $body =~ s{\Q$url\E}{/}gs;
104     # remove cookie variable from url
105     $body =~ s{CARNetweb=[0-9a-f]+}{}gs;
106 dpavlin 164
107 dpavlin 195 =for pQuery
108 dpavlin 164
109 dpavlin 195 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 dpavlin 164
119 dpavlin 195 # $body = $dom->toHtml;
120 dpavlin 164
121 dpavlin 195 =cut
122 dpavlin 164
123 dpavlin 195 my $dom = HTML::Query->new(
124     text => $body,
125     'body',
126     );
127     # warn dump( $dom->as_HTML );
128 dpavlin 196 # $body = $dom->as_HTML->[0];
129 dpavlin 164
130 dpavlin 195 warn "<< ", $self->uri,
131     " ", -s $self->path,
132     " ", $req->params ? dump( $req->params ) : '',
133 dpavlin 166 "\n";
134 dpavlin 164
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 dpavlin 195 warn $body;
155    
156     $req->print( $self->page( title => $self->uri, body => $body ) );
157 dpavlin 164 }
158    
159     1;

  ViewVC Help
Powered by ViewVC 1.1.26