/[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 195 by dpavlin, Tue Oct 28 18:33:53 2008 UTC revision 203 by dpavlin, Thu Oct 30 17:53:09 2008 UTC
# Line 25  has 'mirror' => ( Line 25  has 'mirror' => (
25          default => 1,          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;  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 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    
# Line 55  sub get_page { Line 63  sub get_page {
63                  my $url = $self->uri;                  my $url = $self->uri;
64                  warn ">> mirror $url -> $path\n";                  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                    if ( $self->resolve_links ) {
69                            my $resolver = HTML::ResolveLink->new( base => $url );
70                            $body = $resolver->resolve( $body );
71                    }
72    
73                    write_file( $path, $body );
74                  warn "WW mirror $url -> $path ", -s $path, " bytes\n";                  warn "WW mirror $url -> $path ", -s $path, " bytes\n";
75    
76            } else {
77                    $body = read_file( $path );
78          }          }
79    
         my $body = read_file( $path );  
80          warn "# $path ", -s $path, " == ", length($body), "bytes";          warn "# $path ", -s $path, " == ", length($body), "bytes";
81          return $body;          return $body;
82  }  }
# Line 67  sub get_page { Line 84  sub get_page {
84  sub html {  sub html {
85      my ( $self, $req ) = @_;      my ( $self, $req ) = @_;
86    
87      my $body;          my $body = $self->get_page;
   
         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;  
         }  
   
         $body .= $self->get_page;  
88    
89          # strip full hostname          # strip full hostname
90          my $url = $self->uri;          my $url = $self->uri;
# Line 108  sub html { Line 113  sub html {
113                  'body',                  'body',
114          );          );
115  #       warn dump( $dom->as_HTML );  #       warn dump( $dom->as_HTML );
116          $body = $dom->as_HTML->[0];  #       $body = $dom->as_HTML->[0];
117    
118          warn "<< ", $self->uri,          warn "<< ", $self->uri,
119                  " ", -s $self->path,                  " ", -s $self->path,
Legend:
Removed from v.195  
changed lines
  Added in v.203
  ViewVC Help
Powered by ViewVC 1.1.26