/[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 174 - (hide annotations)
Sat Aug 16 13:03:44 2008 UTC (15 years, 8 months ago) by dpavlin
Original Path: trunk/lib/Frey/Designer.pm
File size: 2354 byte(s)
split types in own package, and added note about redundant
code with MooseX::Types::URI (which I can't use correctly it seems)
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     $path .= '.html' if $path !~ m/\.\w+$/;
57    
58     my $url = $self->uri;
59    
60 dpavlin 166 $self->mirror_design( $c, $path );
61 dpavlin 164
62     $body .= read_file( $path );
63    
64     if ( $path =~ m/\.css$/ ) {
65     $c->res->content_type( "text/css" );
66     } elsif ( $path =~ m/\.(gif|jpe?g|png)$/ ) {
67     my $type = $1;
68     $type =~ s/jpg/jpeg/;
69     $c->res->content_type( "image/$type" );
70     } else {
71     $c->res->content_type( "text/html" );
72    
73     # strip full hostname
74     $body =~ s{\Q$url\E}{/}gs;
75     # remove cookie variable from url
76     $body =~ s{CARNetweb=[0-9a-f]+}{}gs;
77    
78     my $dom = pQuery( $body );
79     # warn dump( $dom->find("body") );
80     $dom->find(".navigation")->each( sub {
81 dpavlin 166 my $html = $_->innerHTML;
82     warn $html;
83     # $_->innerHTML(qq{
84     # <div style="border: 3px dashed black;">$html</div>
85     # });
86 dpavlin 164 } );
87    
88 dpavlin 166 # $body = $dom->toHtml;
89    
90 dpavlin 164 }
91    
92 dpavlin 166 warn "<< ", $c->req->path,
93     " ", -s $path,
94     " ", $c->res->content_type,
95     " ", $c->req->params ? dump( $c->req->params ) : '',
96     "\n";
97 dpavlin 164
98     =for later
99    
100     $body .= strip tt q{
101     <form method="post">
102     <input type="text" name="id" />
103     <input type="submit" />
104     </form>
105    
106     <form method="post" enctype="multipart/form-data">
107     <input type="file" name="upload_file" />
108     <input type="submit" />
109     </form>
110    
111     <pre>[% raw | html %]</pre>
112     <pre>[% req_dump | html %]</pre>
113     };
114    
115     =cut
116    
117     $c->res->body($body);
118     }
119    
120     1;

  ViewVC Help
Powered by ViewVC 1.1.26