/[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 195 by dpavlin, Tue Oct 28 18:33:53 2008 UTC revision 319 by dpavlin, Wed Nov 5 22:11:17 2008 UTC
# Line 12  use Frey::Types; Line 12  use Frey::Types;
12    
13  extends 'Frey';  extends 'Frey';
14  with 'Frey::Web';  with 'Frey::Web';
15    with 'Frey::Path';
16    
17  has 'uri' => (  has 'uri' => (
18          is => 'rw',          is => 'rw',
# Line 25  has 'mirror' => ( Line 26  has 'mirror' => (
26          default => 1,          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;  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 path {  sub path {
45          my $self = shift;          my $self = shift;
46          my $path = 'templates/www.carnet.hr/' . $self->uri->path;          my $path = join('/', ( 'templates', $self->uri->host, $self->uri->path ) );
47          $path .= '.html' if $path !~ m/\.\w+$/;          $path .= '.html' if $path !~ m/\.\w+$/;
48          return $path;          return $path;
49  }  }
# Line 45  sub get_page { Line 52  sub get_page {
52          my ( $self ) = @_;          my ( $self ) = @_;
53    
54          my $path = $self->path;          my $path = $self->path;
55            my $body;
56    
57          if ( ! -e $path && $self->mirror ) {          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                  my $url = $self->uri;                  my $url = $self->uri;
62                  warn ">> mirror $url -> $path\n";                  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                    if ( $self->resolve_links ) {
67                            my $resolver = HTML::ResolveLink->new( base => $url );
68                            $body = $resolver->resolve( $body );
69                    }
70    
71                    write_file( $path, $body );
72                  warn "WW mirror $url -> $path ", -s $path, " bytes\n";                  warn "WW mirror $url -> $path ", -s $path, " bytes\n";
73    
74            } else {
75                    $body = read_file( $path );
76          }          }
77    
         my $body = read_file( $path );  
78          warn "# $path ", -s $path, " == ", length($body), "bytes";          warn "# $path ", -s $path, " == ", length($body), "bytes";
79          return $body;          return $body;
80  }  }
81    
82  sub html {  sub markup {
83      my ( $self, $req ) = @_;      my ( $self ) = @_;
   
     my $body;  
   
         if ( $self->uri->path =~ m{/__bookmarklet} ) {  
                 my $js = read_file( 'static/xpath.js' );  
                 $js =~ s{//.*}{}gm;     # remove comments so that compaction below doesn't screw code  
                 $js =~ s/\s\s+/ /gs;  
         $req->print(qq{  
                         Drag this <a href="javascript:void($js);">bookmarklet</a> to bookmark toolbar or menu to install XPATH inspector  
                 });  
                 return;  
         }  
84    
85          $body .= $self->get_page;          my $body = $self->get_page;
86    
87          # strip full hostname          # strip full hostname
88          my $url = $self->uri;          my $url = $self->uri;
# Line 108  sub html { Line 111  sub html {
111                  'body',                  'body',
112          );          );
113  #       warn dump( $dom->as_HTML );  #       warn dump( $dom->as_HTML );
114          $body = $dom->as_HTML->[0];  #       $body = $dom->as_HTML->[0];
115    
116          warn "<< ", $self->uri,          warn "<< ", $self->uri,
117                  " ", -s $self->path,                  " ", -s $self->path,
                 " ", $req->params ? dump( $req->params ) : '',  
118                  "\n";                  "\n";
119    
120  =for later  =for later
# Line 136  sub html { Line 138  sub html {
138    
139          warn $body;          warn $body;
140    
141          $req->print( $self->page( title => $self->uri, body => $body ) );          return $self->page( title => $self->uri, body => $body );
142  }  }
143    
144  1;  1;
Legend:
Removed from v.195  
changed lines
  Added in v.319
  ViewVC Help
Powered by ViewVC 1.1.26