/[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!
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 540 by dpavlin, Wed Nov 26 18:02:38 2008 UTC revision 543 by dpavlin, Wed Nov 26 19:43:03 2008 UTC
# Line 1  Line 1 
1  package Frey::Web;  package Frey::Web;
2  use Moose::Role;  use Moose::Role;
3    
 with 'Frey::Backtrace';  
   
4  use Frey::Types;  use Frey::Types;
5    
6  use Continuity::Widget::DomNode;  use Continuity::Widget::DomNode;
# Line 49  has 'dump_max_bytes' => ( Line 47  has 'dump_max_bytes' => (
47          is => 'rw',          is => 'rw',
48          isa => 'Int',          isa => 'Int',
49          default => 4096,          default => 4096,
50          documentation => 'Maximum dump size sent to browser before truncation',          documentation => 'maximum dump size sent to browser before truncation',
51  );  );
52    
53  has 'inline_smaller_than' => (  has 'inline_smaller_than' => (
54          is => 'rw',          is => 'rw',
55          isa => 'Int',          isa => 'Int',
56          default => 10240,          default => 10240,
57          documentation => 'Inline JavaScript and CSS to reduce round-trips',          documentation => 'inline JavaScript and CSS to reduce round-trips',
58  );  );
59    
60  has 'chop_warning' => (  has 'html_dump_width' => (
61            documentation => 'crop longer lines in dumps',
62          is => 'rw',          is => 'rw',
63          isa => 'Int',          isa => 'Int',
64          default => 80,  #       required => 1, # FIXME we can't have required fields with defaults because Frey::Action isn't smart enough and asks for them
65          documentation => 'Crop lines longer',          default => 128,
66  );  );
67    
68  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
# Line 76  sub html_escape { Line 75  sub html_escape {
75  }  }
76    
77  sub html_dump {  sub html_dump {
78          my $self = shift;          my ( $self, $dump ) = @_;
79          $self->html_escape( dump( @_ ) );          $dump = dump( $dump ) if ref($dump);
80            my $width = $self->html_dump_width;
81            $dump =~ s{(\n[^\n]{$width})([^\n]+?)([^\n]{5})}{\n$1...$3}gs;
82            $dump = $self->html_escape( $dump );
83            $dump =~ s{\Q...\E}{&hellip;}gs;
84            return "<code>$dump</code>";
85  }  }
86    
87  sub dom2html {  sub dom2html {
# Line 161  sub status { @status }; Line 165  sub status { @status };
165    
166  our $icon_html;  our $icon_html;
167    
168  sub popup {  sub popup    { my $self = shift; $self->popup_dropdown('popup',    @_); }
169          my ( $self, $name, $content, $full ) = @_;  sub dropdown { my $self = shift; $self->popup_dropdown('dropdown', @_); }
170    
171    sub popup_dropdown {
172            my ( $self, $type, $name, $content, $full ) = @_;
173    
174          if ( ref($content) ) {          if ( ref($content) ) {
175                  $content = '<code>' . dump($content) . '</code>';                  $content = $self->html_dump($content);
176                  my $l = length($content);  #               my $l = length($content);
177                  $content = qq|<span>$l bytes</span>| if ! $full && $l > $self->dump_max_bytes;  #               $content = qq|<span>$l bytes</span>| if ! $full && $l > $self->dump_max_bytes;
178          } else {          } else {
179                  $content = qq|<span>$content</span>|;                  $content = qq|<span>$content</span>|;
180          }          }
181    
182          warn "## popup [$name] = ", length( $content ), " bytes" if $self->debug;          warn "## $type [$name] = ", length( $content ), " bytes" if $self->debug;
183          return qq|<span class="frey-popup">$name $content</span>\n|;  
184            if ( $name =~ m{::} && ! $name =~ m{<(\w+).+?/\1>} ) {
185                    return qq|<a class="frey-$type" target="$name" href="/$name">$name $content</a>\n|;
186            } else {
187                    return qq|<span class="frey-$type">$name $content</span>\n|;
188            }
189  }  }
190    
191  sub page {  sub page {
# Line 432  sub warnings_html { Line 444  sub warnings_html {
444    
445                          my $msg = $self->html_escape( $_ );                          my $msg = $self->html_escape( $_ );
446                          my $spacer = ' ';                          my $spacer = ' ';
447                          if ( length($msg) > $self->chop_warning ) {                          if ( length($msg) > $self->html_dump_width ) {
448                                  $msg = substr( $msg, 0, $self->chop_warning );                                  $msg = substr( $msg, 0, $self->html_dump_width );
449                                  $spacer = '&hellip;'                                  $spacer = '&hellip;'
450                          }                          }
451                          $msg =~ s{^\s}{&nbsp;}g;                          $msg =~ s{^\s}{&nbsp;}g;
# Line 450  sub warnings_html { Line 462  sub warnings_html {
462                  ;                  ;
463  }  }
464    
465    
466    =head2 backtrace
467    
468    Show backtrace with links to editor
469    
470      my @backtrace = $self->backtrace;
471    
472    =cut
473    
474    sub backtrace {
475            my ($self) = @_;
476    
477            my @backtrace;
478            foreach ( 0 .. 5 ) {
479                    my (
480                            $package,$path,$line
481                            # subroutine hasargs
482                            # wantarray evaltext is_require
483                            # hints bitmask hinthash
484                    ) = caller($_) or last;
485    
486                    push @backtrace,
487                            qq|via $package from $path <a target="editor" href="/editor+$path+$line">$path</a>|;
488            }
489            warn "# backtrace: ", dump( @backtrace ) if @backtrace;
490            return @backtrace;
491    }
492    
493  1;  1;

Legend:
Removed from v.540  
changed lines
  Added in v.543

  ViewVC Help
Powered by ViewVC 1.1.26