/[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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/lib/Frey/Designer.pm revision 174 by dpavlin, Sat Aug 16 13:03:44 2008 UTC branches/no-pager/lib/Frey/Designer.pm revision 702 by dpavlin, Wed Dec 3 21:12:43 2008 UTC
# Line 1  Line 1 
1  package Frey::Designer;  package Frey::Designer;
   
2  use Moose;  use Moose;
3    
4    =head1 NAME
5    
6    Frey::Designer - modify html (sometime in future)
7    
8    =cut
9    
10  use Frey::Types;  use Frey::Types;
11  #use MooseX::Types::URI qw(Uri FileUri DataUri);  #use MooseX::Types::URI qw(Uri FileUri DataUri);
12    
13    extends 'Frey';
14    with 'Frey::Web';
15    with 'Frey::Path';
16    
17  has 'uri' => (  has 'uri' => (
18          is => 'rw',          is => 'rw',
19          isa => 'Uri', coerce => 1,          isa => 'Uri', coerce => 1,
# Line 12  has 'uri' => ( Line 22  has 'uri' => (
22    
23  has 'mirror' => (  has 'mirror' => (
24          is => 'rw',          is => 'rw',
25          isa => 'Boolean',          isa => 'Bool',
26            default => 1,
27    );
28    
29    has 'resolve_links' => (
30            is => 'rw',
31            isa => 'Bool',
32            default => 1,
33  );  );
34    
35  #use String::TT qw/strip tt/;  #use String::TT qw/strip tt/;
36    
37  use pQuery;  #use pQuery;
38    use HTML::Query;
39  use File::Slurp;  use File::Slurp;
40  use LWP::Simple ();  use LWP::Simple qw/get/;
 use File::Path;  
41  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
42    use HTML::ResolveLink;
43    
44  sub template_path {  sub path {
45          return 'templates/www.carnet.hr/' . shift;          my $self = shift;
46            my $path = join('/', ( 'templates', $self->uri->host, $self->uri->path ) );
47            $path .= '.html' if $path !~ m/\.\w+$/;
48            return $path;
49  }  }
50    
51  sub mirror_design {  sub get_page {
52          my ( $self, $c, $path ) = @_;          my ( $self ) = @_;
         return if -e $path;  
53    
54          return unless $self->mirror;          my $path = $self->path;
55            my $body;
56    
57          my $url = $self->uri . '/' . $c->req->path . '?' . $c->req->uri->query;          if ( ! -e $path && $self->mirror ) {
58    
59          my $base_path = $path;                  $self->mkbasepath( $path );
         $base_path =~ s{/[^/]+$}{};  
         mkpath $base_path if ! -e $base_path;  
60    
61          warn ">> mirror $url -> $path\n";                  my $url = $self->uri;
62                    warn ">> mirror $url -> $path\n";
63    
64          LWP::Simple::mirror( $url, $path ) or die "can't mirror $url: $!";                  $body = get( $url ) or die "can't mirror $url: $!";
 }  
65    
66  sub handler {                  if ( $self->resolve_links ) {
67      my ( $self, $c ) = @_;                          my $resolver = HTML::ResolveLink->new( base => $url );
68                            $body = $resolver->resolve( $body );
69                    }
70    
71      my $req_dump = dump( $c->req );                  write_file( $path, $body );
72      my $raw      = $c->req->raw_body;                  warn "WW mirror $url -> $path ", -s $path, " bytes\n";
     my $body;  
73    
74          my $path = template_path( $c->req->path );          } else {
75                    $body = read_file( $path );
76          $path .= '.html' if $path !~ m/\.\w+$/;          }
77    
78          my $url = $self->uri;          warn "# $path ", -s $path, " == ", length($body), "bytes";
79            return $body;
80    }
81    
82          $self->mirror_design( $c, $path );  sub as_markup {
83        my ( $self ) = @_;
84    
85          $body .= read_file( $path );          my $body = $self->get_page;
86    
87          if ( $path =~ m/\.css$/ ) {          # strip full hostname
88                  $c->res->content_type( "text/css" );          my $url = $self->uri;
89          } elsif ( $path =~ m/\.(gif|jpe?g|png)$/ ) {          $body =~ s{\Q$url\E}{/}gs;
90                  my $type = $1;          # remove cookie variable from url
91                  $type =~ s/jpg/jpeg/;          $body =~ s{CARNetweb=[0-9a-f]+}{}gs;
92                  $c->res->content_type( "image/$type" );  
93          } else {  =for pQuery
94                  $c->res->content_type( "text/html" );  
95            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    
105                  # strip full hostname  #       $body = $dom->toHtml;
                 $body =~ s{\Q$url\E}{/}gs;  
                 # remove cookie variable from url  
                 $body =~ s{CARNetweb=[0-9a-f]+}{}gs;  
   
                 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>  
 #                       });  
                 } );  
106    
107  #               $body = $dom->toHtml;  =cut
108    
109          }          my $dom = HTML::Query->new(
110                    text => $body,
111                    'body',
112            );
113    #       warn dump( $dom->as_HTML );
114    #       $body = $dom->as_HTML->[0];
115    
116          warn "<< ", $c->req->path,          warn "<< ", $self->uri,
117                  " ", -s $path,                  " ", -s $self->path,
                 " ", $c->res->content_type,  
                 " ", $c->req->params ? dump( $c->req->params ) : '',  
118                  "\n";                  "\n";
119    
120  =for later  =for later
# Line 114  sub handler { Line 136  sub handler {
136    
137  =cut  =cut
138    
139      $c->res->body($body);          warn $body;
140    
141            return $self->page( title => $self->uri, body => $body );
142  }  }
143    
144  1;  1;
Legend:
Removed from v.174  
changed lines
  Added in v.702
  ViewVC Help
Powered by ViewVC 1.1.26