/[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 1065 by dpavlin, Mon Apr 27 18:43:18 2009 UTC revision 1109 by dpavlin, Mon Jun 29 16:54:02 2009 UTC
# Line 2  package Frey::Web; Line 2  package Frey::Web;
2  use Moose::Role;  use Moose::Role;
3    
4  with 'Frey::Session';  with 'Frey::Session';
5    with 'Frey::Class::Icon';
6    
7  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
8  use Carp qw/confess cluck carp/;  use Carp qw/confess cluck carp/;
# Line 262  our $reload_counter = 0; Line 263  our $reload_counter = 0;
263  our @status;  our @status;
264  sub status { @status };  sub status { @status };
265    
 our $icon_html;  
   
266  sub html_page {  sub html_page {
267          my $self = shift;          my $self = shift;
268          my $a = {@_};          my $a = {@_};
# Line 314  sub html_page { Line 313  sub html_page {
313          my $revision = $svk->info->{Revision} || '';          my $revision = $svk->info->{Revision} || '';
314          $revision = $1 if $info->{'Mirrored From'} =~ m{Rev\.\s+(\d+)};          $revision = $1 if $info->{'Mirrored From'} =~ m{Rev\.\s+(\d+)};
315    
316          $self->add_icon unless $icon_html;          $self->add_icon;
317    
318          my $title = undef          my $title = undef
319                  || $a->{title}                  || $a->{title}
# Line 335  sub html_page { Line 334  sub html_page {
334                  $self->_head_html,                  $self->_head_html,
335                  qq|<title>$title</title>|,                  qq|<title>$title</title>|,
336                  '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">',                  '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">',
337                  ( $icon_html || '<!-- no icon -->' ),                  ( $self->icon_html ),
338                  ( $a->{head} || '' ),                  ( $a->{head} || '' ),
339                  qq|                  qq|
340                  </head><body>                  </head><body>
# Line 486  Called at beginning of each request Line 485  Called at beginning of each request
485    
486  sub clean_status {  sub clean_status {
487          my ($self) = shift;          my ($self) = shift;
488            warn "## clean_status";
489          @head = ( 'static/frey.css' );          @head = ( 'static/frey.css' );
490          @status = (          @status = (
491                  { 'ClassBrowser' => Frey::Class::Browser->new( usage_sort => 1, usage_on_top => 0 )->as_markup },                  { 'ClassBrowser' => Frey::Class::Browser->new( usage_sort => 1, usage_on_top => 0 )->as_markup },
492                  { 'Bookmarklets' => Frey::Bookmarklet->new->as_markup },                  { 'Bookmarklets' => Frey::Bookmarklet->new->as_markup },
493                  { 'INC' => Frey::INC->new->as_markup },                  { 'INC' => Frey::INC->new->as_markup },
494          );          );
         $icon_html = '';  
495  }  }
496    
497  =head2 status_parts  =head2 status_parts
# Line 516  sub DEMOLISH { Line 515  sub DEMOLISH {
515    
516  =cut  =cut
517    
 =head2 add_icon  
   
   Frey::Foo->add_icon;            # /static/icons/Frey/Foo.png  
   Frey::Foo->add_icon('warning'); # /static/icons/Frey/Foo/warning.png  
   
 =cut  
   
 sub icon_path {  
         my ($self,$class,$variant) = @_;  
   
         sub icon_exists {  
                 my $class = shift;  
                 $class =~ s{::}{/}g;  
                 $class .= "/$variant" if $variant;  
                 my $icon_path = 'static/icons/' . $class . '.png';  
                 return $icon_path if -e $icon_path;  
                 return;  
         }  
   
         my $path = icon_exists( $class );  
         if ( ! $path ) {  
                 my $super_class = $class;  
                 while ( $super_class =~ s{::[^:]+$}{} && ! $path ) {  
                         $path = icon_exists( $super_class ) unless $super_class eq 'Frey'; # don't default on Frey icon  
                 }  
         }  
   
         if ( ! $path ) {  
                 $self->TODO( "add icon for $class" . ( $variant ? " variant $variant" : '' ) );  
                 return undef;  
         }  
   
         warn "# $class from $self icon_path $path" if $self->debug;  
         return $path;  
 }  
   
 sub add_icon {  
         my ($self,$variant) = @_;  
   
         my $class = $self->class if $self->can('class');  
         #$class ||= $self->title;  
         $class ||= ref($self);  
         my $icon_path = $self->icon_path( $class, $variant ) || return;  
   
         $icon_html .= qq|<link rel="icon" type="image/png" href="/$icon_path">|;  
         warn "# using icon $icon_path";  
   
 =for later  
   
         # FIXME http://en.wikipedia.org/wiki/Favicon suggest just rel="icon" but that doesn't seem to work!  
         my $ico_path = $icon_path;  
         $ico_path =~ s{png$}{ico};  
         if ( ! -e $ico_path ) {  
                 system "convert $icon_path $ico_path";  
                 warn "# convert $icon_path $ico_path : $@";  
         }  
         $icon_html .= qq|<link rel="shortcut icon" type="image/x-icon" href="/$ico_path">| if -e $ico_path;  
   
 =cut  
   
 }  
   
518  my $warn_colors = {  my $warn_colors = {
519          '#'  => '#444',          '#'  => '#444',
520          '##' => '#888',          '##' => '#888',
Legend:
Removed from v.1065  
changed lines
  Added in v.1109
  ViewVC Help
Powered by ViewVC 1.1.26