/[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 164 by dpavlin, Sun Aug 10 16:01:07 2008 UTC revision 175 by dpavlin, Sat Aug 16 23:37:42 2008 UTC
# Line 1  Line 1 
1  package Frey::Designer;  package Frey::Designer;
2    
3  use Moose;  use Moose;
4  use Moose::Util::TypeConstraints;  use Frey::Types;
5    #use MooseX::Types::URI qw(Uri FileUri DataUri);
 use URI ();  
   
 subtype 'Uri'  
         => as 'Object'  
         => where { $_->isa('URI') };  
     
 coerce 'Uri'  
         => from 'Object'  
         => via { $_->isa('URI')  
                 ? $_  
                 : Params::Coerce::coerce( 'URI', $_ ) }  
         => from 'Str'  
                 => via { URI->new( $_ ) };  
6    
7  has 'uri' => (  has 'uri' => (
8          is => 'rw',          is => 'rw',
9          isa => 'Uri',          isa => 'Uri', coerce => 1,
         coerce => 1,  
10          required => 1,          required => 1,
11  );  );
12    
13    has 'mirror' => (
14            is => 'rw',
15            isa => 'Boolean',
16    );
17    
18  #use String::TT qw/strip tt/;  #use String::TT qw/strip tt/;
19    
20  use pQuery;  use pQuery;
21  use File::Slurp;  use File::Slurp;
22  use LWP::Simple;  use LWP::Simple ();
23  use File::Path;  use File::Path;
24  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
25    
# Line 37  sub template_path { Line 28  sub template_path {
28  }  }
29    
30  sub mirror_design {  sub mirror_design {
31          my ( $url, $path ) = @_;          my ( $self, $c, $path ) = @_;
32          return if -e $path;          return if -e $path;
33    
34            return unless $self->mirror;
35    
36            my $url = $self->uri . '/' . $c->req->path . '?' . $c->req->uri->query;
37    
38          my $base_path = $path;          my $base_path = $path;
39          $base_path =~ s{/[^/]+$}{};          $base_path =~ s{/[^/]+$}{};
40          mkpath $base_path if ! -e $base_path;          mkpath $base_path if ! -e $base_path;
41    
42          warn ">> mirror $url -> $path\n";          warn ">> mirror $url -> $path\n";
43    
44          mirror( $url, $path ) or die "can't mirror $url: $!";          LWP::Simple::mirror( $url, $path ) or die "can't mirror $url: $!";
45  }  }
46    
47  sub handler {  sub handler {
# Line 58  sub handler { Line 53  sub handler {
53    
54          my $path = template_path( $c->req->path );          my $path = template_path( $c->req->path );
55    
56            if ( $path =~ m{/__bookmarklet} ) {
57                    $c->res->content_type( "text/html" );
58                    my $js = read_file( 'static/xpath.js' );
59                    $js =~ s{//.*}{}gm;     # remove comments so that compaction below doesn't screw code
60                    $js =~ s/\s\s+/ /gs;
61            $c->res->body(qq{
62                            drag this look to bookmark <a href="javascript:void($js);">xpath?</a> to install XPATH inspector
63                            <p><a href="http://www.google.com/">link test</a>
64                    });
65                    return;
66            }
67    
68          $path .= '.html' if $path !~ m/\.\w+$/;          $path .= '.html' if $path !~ m/\.\w+$/;
69    
70          my $url = $self->uri;          my $url = $self->uri;
71    
72          mirror_design( $url . $c->req->path, $path );          $self->mirror_design( $c, $path );
73    
74          $body .= read_file( $path );          $body .= read_file( $path );
75    
# Line 83  sub handler { Line 90  sub handler {
90                  my $dom = pQuery( $body );                  my $dom = pQuery( $body );
91  #               warn dump( $dom->find("body") );  #               warn dump( $dom->find("body") );
92                  $dom->find(".navigation")->each( sub {                  $dom->find(".navigation")->each( sub {
93                          warn dump( $_->innerHTML );                          my $html = $_->innerHTML;
94                            warn $html;
95    #                       $_->innerHTML(qq{
96    #                               <div style="border: 3px dashed black;">$html</div>
97    #                       });
98                  } );                  } );
99    
100    #               $body = $dom->toHtml;
101    
102          }          }
103    
104          warn "<< ", $c->req->path, " ", -s $path, " ", $c->res->content_type, "\n";          warn "<< ", $c->req->path,
105                    " ", -s $path,
106                    " ", $c->res->content_type,
107                    " ", $c->req->params ? dump( $c->req->params ) : '',
108                    "\n";
109    
110  =for later  =for later
111    
Legend:
Removed from v.164  
changed lines
  Added in v.175
  ViewVC Help
Powered by ViewVC 1.1.26