/[Frey]/branches/zimbardo/lib/Frey/Web.pm

This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!

Diff of /branches/zimbardo/lib/Frey/Web.pm

Parent Directory | Revision Log | View Patch Patch

-revision 100 by dpavlin,
Fri Jul 11 19:19:42 2008 UTC
+revision 445 by dpavlin,
Wed Nov 19 03:00:46 2008 UTC
 Line 1
  package Frey::Web;
  use Moose::Role;
+ use Frey::Types;
  use Continuity::Widget::DomNode;
  use Data::Dump qw/dump/;
+ use Carp qw/confess/;
+ use File::Slurp;
+ use Frey::Bookmarklet;
+ use Frey::ClassBrowser;
+ has 'head' => (
+         is => 'rw',
+         isa => 'ArrayRef[Str]',
+         default => sub { [ 'static/frey.css' ] },
+ );
+ has 'status' => (
+         is => 'rw',
+         isa => 'ArrayRef[HashRef[Str]]',
+         lazy => 1,
+         default => sub { [
+                 { 'Bookmarklets' => Frey::Bookmarklet->new->markup },
+                 { 'ClassBrowser' => Frey::ClassBrowser->new( usage_on_top => 0 )->markup },
+         ] },
+ );
+ has 'request_url' => (
+         is => 'rw',
+         isa => 'Uri', coerce => 1,
+         default => '/',
+ );
+ has 'title' => (
+         is => 'rw',
+         isa => 'Str',
+         lazy => 1,
+         default => sub {
+                 my ($self) = @_;
+                 ref($self);
+         },
+ );
+ =head2 inline_smaller_than
+ Inline JavaScript and CSS smaller than this size into page reducing
+ round-trips to server.
+ =cut
+ has 'inline_smaller_than' => (
+         is => 'rw',
+         isa => 'Int',
+         default => 10240,
+ );
  sub dom2html {
-         warn "## dom2html ",dump( @_ );
+ #       warn "## dom2html ",dump( @_ );
          return Continuity::Widget::DomNode->create( @_ )->to_string;
  }
- our @javascript = ( qw'
+ sub _inline_path {
- ../lib/Joose.js
+         my ( $self, $path ) = @_;
- ');
+         -s $path < $self->inline_smaller_than;
+ }
- sub head_javascript {
+ sub _head_html {
          my $self = shift;
+         my $out = '';
+         foreach my $path ( @{ $self->head } ) {
+                 $path =~ s!^/!!;
+                 if ( $path =~ m/\.js$/ ) {
+                         $out .= $self->_inline_path( $path ) ?
+                                 qq|<!-- $path --><script type="text/javascript">\n| . read_file($path) . qq|\n</script>| :
+                                 qq|<script type="text/javascript" src="/$path"></script>|;
+                 } elsif ( $path =~ m/\.css$/ ) {
+                         $out .= $self->_inline_path( $path ) ?
+                                 qq|<!-- $path --><style type="text/css">\n| . read_file( $path ) . qq|\n</style>| :
+                                 qq|<link type="text/css" rel="stylesheet" href="/$path" media="screen">|;
+                 } elsif ( $path =~ m{<.+>} ) {
+                         $out .= $path;
+                 } else {
+                         confess "don't know how to render $path";
+                 }
+                 $out .= "\n";
+         }
+         return $out;
+ }
+ =head2 add_head
+   $o->add_head( 'path/to/external.js' );
+   my $size = $o->add_head( 'path/to/external.css' );
+   $o->add_head( '<!-- html content -->' );
+ =cut
+ sub add_head {
+         my ( $self, $path ) = @_;
+         return if ! defined $path || $path eq '';
+         $path =~ s!^/!!;
+         if ( $path =~ m{<.*>} ) {
+                 push @{ $self->head }, $path;
+         } elsif ( -e $path ) {
+                 if ( $path =~ m/\.(?:js|css)$/ ) {
+                         push @{ $self->head }, $path;
+                 } else {
+                         confess "can't add_head( $path ) it's not js or css";
+                 }
+                 return -s $path;
+         } else {
+                 confess "can't find $path: $!";
+         }
+ }
-         my $js = Continuity::Widget::DomNode->create(
+ our $reload_counter = 0;
-                 map {
-                         ( script => { type => 'text/javascript', src => $_ } )
-                 } @javascript
-         )->to_string;
-         warn "# >>> js\n$js\n" if $self->debug;
-         return $js;
+ =head2 page
+   $self->page(
+         title => 'page title',
+         head  => '<!-- optional head markup -->',
+         body  => '<b>Page Body</b>',
+   );
+ =cut
+ sub page {
+         my $self = shift;
+         my $a = {@_};
+         $reload_counter++;
+         my $status_line = '';
+         foreach my $part ( @{ $self->status } ) {
+                 if ( ref($part) ne 'HASH' ) {
+                         warn "part not hash ",dump( $part ) ;
+                         #$self->status( $part );
+                         next;
+                 }
+                 foreach my $name ( keys %$part ) {
+                         my $content = $part->{$name};
+                         if ( ref($content) ) {
+                                 $content = '<code>' . dump($content) . '</code>';
+                                 my $l = length($content);
+                                 $content = qq|<span>$l bytes</span>| if $l > 1024;
+                         } else {
+                                 $content = qq|<span>$content</span>|;
+                         }
+                         warn "### part [$name] = ", length( $content ), " bytes" if $self->debug;
+                         $status_line .= qq|<span class="frey-popup">$name $content</span>\n|;
+                 }
+         }
+         my $url = $self->request_url;
+         $url =~ s{\?reload=\d+}{};
+         my $html = join("\n",
+                 qq|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>|,
+                 $self->_head_html,
+                 '<title>' . ( $self->title || $a->{title} || ref($self) ) . '</title>',
+                 '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">',
+                 ( $a->{head} || '' ),
+                 '</head><body>',
+                 ( $a->{body} || $self->markup || '<!-- no body -->' ),
+                 qq|
+                 <div class="frey-status-line">
+                         <a href="/">Frey</a> $Frey::VERSION
+                         <a href="?reload=$reload_counter"><code>$url</code></a>
+                         $status_line
+                 </div>
+             </body></html>
+                 |,
+         );
+         warn "## >>> page ",length($html), " bytes\n" if $self->debug;
+         return $html;
+ }
+ sub error {
+         my $self = shift;
+         my $error = join(" ", @_);
+         my ($package, $filename, $line) = caller;
+         $error .= " at $filename line $line" if $error !~ m{ at };
+         warn "WARN: $error\n";
+         $error =~ s{at\s+(\S+)\s+line\s+(\d+)}{at <a target="editor" href="/editor+$1+$2">$1</a> line $2}gsm;
+         $error =~ s{(via package ")([\w:]+)(")}{$1<a target="editor" href="/editor+$2+1">$2</a>$3}gsm;
+         return qq|<pre class="frey-error">$error</pre>|;
  }
 ;

 Legend:



Removed from v.100
 


changed lines


 
Added in v.445
 Legend:



Removed from v.100
 


changed lines


 
Added in v.445
-Removed from v.100
+Added in v.445

	ViewVC Help
Powered by ViewVC 1.1.26