/[Frey]/trunk/lib/Frey/Class/Icon.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

Annotation of /trunk/lib/Frey/Class/Icon.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1133 - (hide annotations)
Tue Jun 30 15:10:55 2009 UTC (14 years, 10 months ago) by dpavlin
File size: 1926 byte(s)
make classes immutable and remove moose droppings to make Perl::Critic::Moose happy
1 dpavlin 1109 package Frey::Class::Icon;
2     use Moose::Role;
3    
4     has 'icon_html' => (
5     is => 'rw',
6     # isa => 'HTML', # FIXME
7     default => '<!-- no icon -->',
8     );
9    
10     =head2 add_icon
11    
12     Frey::Foo->add_icon; # /static/icons/Frey/Foo.png
13     Frey::Foo->add_icon('warning'); # /static/icons/Frey/Foo/warning.png
14    
15     =cut
16    
17     sub icon_path {
18     my ($self,$class,$variant) = @_;
19    
20     sub icon_exists {
21     my $class = shift;
22     $class =~ s{::}{/}g;
23 dpavlin 1129 $class .= '/' . $variant if $variant;
24 dpavlin 1109 my $icon_path = 'static/icons/' . $class . '.png';
25     return $icon_path if -e $icon_path;
26     return;
27     }
28    
29     my $path = icon_exists( $class );
30     if ( ! $path ) {
31     my $super_class = $class;
32     while ( $super_class =~ s{::[^:]+$}{} && ! $path ) {
33     $path = icon_exists( $super_class ) unless $super_class eq 'Frey'; # don't default on Frey icon
34     }
35     }
36    
37     if ( ! $path ) {
38     $self->TODO( "add icon for $class" . ( $variant ? " variant $variant" : '' ) );
39     return undef;
40     }
41    
42     warn "# $class from $self icon_path $path" if $self->debug;
43     return $path;
44     }
45    
46     sub add_icon {
47     my ($self,$variant) = @_;
48    
49     my $class = $self->class if $self->can('class');
50     #$class ||= $self->title;
51     $class ||= ref($self);
52 dpavlin 1129 warn "XXXXX class: $class";
53     my $icon_path = $self->icon_path( $class, $variant );
54     if ( ! -e $icon_path ) {
55     warn "FIXME icon $class $variant";
56     $self->icon_html( qq|<!-- no icon for $class -->| );
57     return;
58     }
59 dpavlin 1109
60 dpavlin 1129 $self->icon_html( qq|<link rel="icon" type="image/png" href="/$icon_path">| );
61     warn "# using icon $icon_path for $class $variant ", $self->icon_html;
62 dpavlin 1109
63     =for later
64    
65     # FIXME http://en.wikipedia.org/wiki/Favicon suggest just rel="icon" but that doesn't seem to work!
66     my $ico_path = $icon_path;
67     $ico_path =~ s{png$}{ico};
68     if ( ! -e $ico_path ) {
69     system "convert $icon_path $ico_path";
70     warn "# convert $icon_path $ico_path : $@";
71     }
72     $icon_html .= qq|<link rel="shortcut icon" type="image/x-icon" href="/$ico_path">| if -e $ico_path;
73    
74     =cut
75    
76     }
77    
78 dpavlin 1133 no Moose::Role;
79    
80 dpavlin 1109 1;

  ViewVC Help
Powered by ViewVC 1.1.26