/[Frey]/trunk/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 /trunk/lib/Frey/Designer.pm

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

revision 194 by dpavlin, Sat Aug 16 23:37:42 2008 UTC revision 195 by dpavlin, Tue Oct 28 18:33:53 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    
16  has 'uri' => (  has 'uri' => (
17          is => 'rw',          is => 'rw',
18          isa => 'Uri', coerce => 1,          isa => 'Uri', coerce => 1,
# Line 12  has 'uri' => ( Line 21  has 'uri' => (
21    
22  has 'mirror' => (  has 'mirror' => (
23          is => 'rw',          is => 'rw',
24          isa => 'Boolean',          isa => 'Bool',
25            default => 1,
26  );  );
27    
28  #use String::TT qw/strip tt/;  #use String::TT qw/strip tt/;
29    
30  use pQuery;  #use pQuery;
31    use HTML::Query;
32  use File::Slurp;  use File::Slurp;
33  use LWP::Simple ();  use LWP::Simple ();
34  use File::Path;  use File::Path;
35  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
36    
37  sub template_path {  sub path {
38          return 'templates/www.carnet.hr/' . shift;          my $self = shift;
39            my $path = 'templates/www.carnet.hr/' . $self->uri->path;
40            $path .= '.html' if $path !~ m/\.\w+$/;
41            return $path;
42  }  }
43    
44  sub mirror_design {  sub get_page {
45          my ( $self, $c, $path ) = @_;          my ( $self ) = @_;
46          return if -e $path;  
47            my $path = $self->path;
48    
49          return unless $self->mirror;          if ( ! -e $path && $self->mirror ) {
50    
51          my $url = $self->uri . '/' . $c->req->path . '?' . $c->req->uri->query;                  my $base_path = $path;
52                    $base_path =~ s{/[^/]+$}{};
53                    mkpath $base_path if ! -e $base_path;
54    
55          my $base_path = $path;                  my $url = $self->uri;
56          $base_path =~ s{/[^/]+$}{};                  warn ">> mirror $url -> $path\n";
         mkpath $base_path if ! -e $base_path;  
57    
58          warn ">> mirror $url -> $path\n";                  LWP::Simple::mirror( $url, $path ) or die "can't mirror $url: $!";
59                    warn "WW mirror $url -> $path ", -s $path, " bytes\n";
60            }
61    
62          LWP::Simple::mirror( $url, $path ) or die "can't mirror $url: $!";          my $body = read_file( $path );
63            warn "# $path ", -s $path, " == ", length($body), "bytes";
64            return $body;
65  }  }
66    
67  sub handler {  sub html {
68      my ( $self, $c ) = @_;      my ( $self, $req ) = @_;
69    
     my $req_dump = dump( $c->req );  
     my $raw      = $c->req->raw_body;  
70      my $body;      my $body;
71    
72          my $path = template_path( $c->req->path );          if ( $self->uri->path =~ m{/__bookmarklet} ) {
   
         if ( $path =~ m{/__bookmarklet} ) {  
                 $c->res->content_type( "text/html" );  
73                  my $js = read_file( 'static/xpath.js' );                  my $js = read_file( 'static/xpath.js' );
74                  $js =~ s{//.*}{}gm;     # remove comments so that compaction below doesn't screw code                  $js =~ s{//.*}{}gm;     # remove comments so that compaction below doesn't screw code
75                  $js =~ s/\s\s+/ /gs;                  $js =~ s/\s\s+/ /gs;
76          $c->res->body(qq{          $req->print(qq{
77                          drag this look to bookmark <a href="javascript:void($js);">xpath?</a> to install XPATH inspector                          Drag this <a href="javascript:void($js);">bookmarklet</a> to bookmark toolbar or menu to install XPATH inspector
                         <p><a href="http://www.google.com/">link test</a>  
78                  });                  });
79                  return;                  return;
80          }          }
81    
82          $path .= '.html' if $path !~ m/\.\w+$/;          $body .= $self->get_page;
83    
84            # strip full hostname
85          my $url = $self->uri;          my $url = $self->uri;
86            $body =~ s{\Q$url\E}{/}gs;
87            # remove cookie variable from url
88            $body =~ s{CARNetweb=[0-9a-f]+}{}gs;
89    
90    =for pQuery
91    
92            my $dom = pQuery( $body );
93    #       warn dump( $dom->find("body") );
94            $dom->find(".navigation")->each( sub {
95                    my $html = $_->innerHTML;
96                    warn $html;
97    #               $_->innerHTML(qq{
98    #                       <div style="border: 3px dashed black;">$html</div>
99    #               });
100            } );
101    
102          $self->mirror_design( $c, $path );  #       $body = $dom->toHtml;
   
         $body .= read_file( $path );  
   
         if ( $path =~ m/\.css$/ ) {  
                 $c->res->content_type( "text/css" );  
         } elsif ( $path =~ m/\.(gif|jpe?g|png)$/ ) {  
                 my $type = $1;  
                 $type =~ s/jpg/jpeg/;  
                 $c->res->content_type( "image/$type" );  
         } else {  
                 $c->res->content_type( "text/html" );  
   
                 # strip full hostname  
                 $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>  
 #                       });  
                 } );  
103    
104  #               $body = $dom->toHtml;  =cut
   
         }  
105    
106          warn "<< ", $c->req->path,          my $dom = HTML::Query->new(
107                  " ", -s $path,                  text => $body,
108                  " ", $c->res->content_type,                  'body',
109                  " ", $c->req->params ? dump( $c->req->params ) : '',          );
110    #       warn dump( $dom->as_HTML );
111            $body = $dom->as_HTML->[0];
112    
113            warn "<< ", $self->uri,
114                    " ", -s $self->path,
115                    " ", $req->params ? dump( $req->params ) : '',
116                  "\n";                  "\n";
117    
118  =for later  =for later
# Line 126  sub handler { Line 134  sub handler {
134    
135  =cut  =cut
136    
137      $c->res->body($body);          warn $body;
138    
139            $req->print( $self->page( title => $self->uri, body => $body ) );
140  }  }
141    
142  1;  1;
Legend:
Removed from v.194  
changed lines
  Added in v.195
  ViewVC Help
Powered by ViewVC 1.1.26