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

revision 166 by dpavlin, Mon Aug 11 19:32:29 2008 UTC revision 196 by dpavlin, Tue Oct 28 19:34:10 2008 UTC
# Line 1  Line 1 
1  package Frey::Designer;  package Frey::Designer;
   
2  use Moose;  use Moose;
 use Moose::Util::TypeConstraints;  
3    
4  use URI ();  =head1 NAME
5    
6    Frey::Designer - modify html (sometime in future)
7    
8    =cut
9    
10    use Frey::Types;
11    #use MooseX::Types::URI qw(Uri FileUri DataUri);
12    
13  subtype 'Uri'  extends 'Frey';
14          => as 'Object'  with 'Frey::Web';
         => where { $_->isa('URI') };  
     
 coerce 'Uri'  
         => from 'Object'  
         => via { $_->isa('URI')  
                 ? $_  
                 : Params::Coerce::coerce( 'URI', $_ ) }  
         => from 'Str'  
                 => via { URI->new( $_ ) };  
15    
16  has 'uri' => (  has 'uri' => (
17          is => 'rw',          is => 'rw',
18          isa => 'Uri',          isa => 'Uri', coerce => 1,
         coerce => 1,  
19          required => 1,          required => 1,
20  );  );
21    
22  has 'mirror' => (  has 'mirror' => (
23          is => 'rw',          is => 'rw',
24          isa => 'Boolean',          isa => 'Bool',
25            default => 1,
26    );
27    
28    has 'resolve_links' => (
29            is => 'rw',
30            isa => 'Bool',
31            default => 1,
32  );  );
33    
34  #use String::TT qw/strip tt/;  #use String::TT qw/strip tt/;
35    
36  use pQuery;  #use pQuery;
37    use HTML::Query;
38  use File::Slurp;  use File::Slurp;
39  use LWP::Simple ();  use LWP::Simple qw/get/;
40  use File::Path;  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 = 'templates/www.carnet.hr/' . $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;                  my $base_path = $path;
60          $base_path =~ s{/[^/]+$}{};                  $base_path =~ s{/[^/]+$}{};
61          mkpath $base_path if ! -e $base_path;                  mkpath $base_path if ! -e $base_path;
62    
63          warn ">> mirror $url -> $path\n";                  my $url = $self->uri;
64                    warn ">> mirror $url -> $path\n";
65    
66          LWP::Simple::mirror( $url, $path ) or die "can't mirror $url: $!";                  $body = get( $url ) or die "can't mirror $url: $!";
 }  
67    
68  sub handler {                  if ( $self->resolve_links ) {
69      my ( $self, $c ) = @_;                          my $resolver = HTML::ResolveLink->new( base => $url );
70                            $body = $resolver->resolve( $body );
71                    }
72    
73      my $req_dump = dump( $c->req );                  write_file( $path, $body );
74      my $raw      = $c->req->raw_body;                  warn "WW mirror $url -> $path ", -s $path, " bytes\n";
     my $body;  
75    
76          my $path = template_path( $c->req->path );          } else {
77                    $body = read_file( $path );
78            }
79    
80          $path .= '.html' if $path !~ m/\.\w+$/;          warn "# $path ", -s $path, " == ", length($body), "bytes";
81            return $body;
82    }
83    
84          my $url = $self->uri;  sub html {
85        my ( $self, $req ) = @_;
86    
87          $self->mirror_design( $c, $path );      my $body;
88    
89          $body .= read_file( $path );          if ( $self->uri->path =~ m{/__bookmarklet} ) {
90                    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            $req->print(qq{
94                            Drag this <a href="javascript:void($js);">bookmarklet</a> to bookmark toolbar or menu to install XPATH inspector
95                    });
96                    return;
97            }
98    
99          if ( $path =~ m/\.css$/ ) {          $body .= $self->get_page;
                 $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" );  
100    
101                  # strip full hostname          # strip full hostname
102                  $body =~ s{\Q$url\E}{/}gs;          my $url = $self->uri;
103                  # remove cookie variable from url          $body =~ s{\Q$url\E}{/}gs;
104                  $body =~ s{CARNetweb=[0-9a-f]+}{}gs;          # remove cookie variable from url
105            $body =~ s{CARNetweb=[0-9a-f]+}{}gs;
106                  my $dom = pQuery( $body );  
107  #               warn dump( $dom->find("body") );  =for pQuery
108                  $dom->find(".navigation")->each( sub {  
109                          my $html = $_->innerHTML;          my $dom = pQuery( $body );
110                          warn $html;  #       warn dump( $dom->find("body") );
111  #                       $_->innerHTML(qq{          $dom->find(".navigation")->each( sub {
112  #                               <div style="border: 3px dashed black;">$html</div>                  my $html = $_->innerHTML;
113  #                       });                  warn $html;
114                  } );  #               $_->innerHTML(qq{
115    #                       <div style="border: 3px dashed black;">$html</div>
116    #               });
117            } );
118    
119  #               $body = $dom->toHtml;  #       $body = $dom->toHtml;
120    
121          }  =cut
122    
123          warn "<< ", $c->req->path,          my $dom = HTML::Query->new(
124                  " ", -s $path,                  text => $body,
125                  " ", $c->res->content_type,                  'body',
126                  " ", $c->req->params ? dump( $c->req->params ) : '',          );
127    #       warn dump( $dom->as_HTML );
128    #       $body = $dom->as_HTML->[0];
129    
130            warn "<< ", $self->uri,
131                    " ", -s $self->path,
132                    " ", $req->params ? dump( $req->params ) : '',
133                  "\n";                  "\n";
134    
135  =for later  =for later
# Line 128  sub handler { Line 151  sub handler {
151    
152  =cut  =cut
153    
154      $c->res->body($body);          warn $body;
155    
156            $req->print( $self->page( title => $self->uri, body => $body ) );
157  }  }
158    
159  1;  1;
Legend:
Removed from v.166  
changed lines
  Added in v.196
  ViewVC Help
Powered by ViewVC 1.1.26