/[Frey]/branches/no-pager/lib/Frey/Pod.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/no-pager/lib/Frey/Pod.pm

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

revision 344 by dpavlin, Sat Nov 15 16:10:45 2008 UTC revision 691 by dpavlin, Tue Dec 2 22:06:05 2008 UTC
# Line 18  has 'class' => ( Line 18  has 'class' => (
18    
19  use File::Slurp;  use File::Slurp;
20  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
21    use Pod::Find qw/pod_where/;
22    
23  sub request {  sub as_markup {
         my ( $self, $req ) = @_;  
         my $f = { $req->params };  
         my $class = delete( $f->{class} ) || $self->class;  
         $req->print( $self->page( title => $class, body => $self->markup( $class ) ) );  
 }  
   
 sub markup {  
24          my $self = shift;          my $self = shift;
25          my $class = $self->class;          my $class = $self->class;
26          use Pod::Simple::HTML;          use Pod::Simple::HTML;
27          my $path = eval { $self->class_path( $class ) };          my $path = pod_where( { -inc => 1 }, $class );
28          if ( $@ ) {          return $self->error( "Can't find pod for $class" ) unless $path;
                 warn $@;  
                 return qq|<div class="error"><code>$@</code></div>|;  
         }  
29          my $pod = read_file( $path );          my $pod = read_file( $path );
30          my $converter = Pod::Simple::HTML->new();          my $converter = Pod::Simple::HTML->new();
31          my $body;          my $body;
# Line 44  sub markup { Line 35  sub markup {
35          $body =~ s{.*?<body [^>]+>}{}s;          $body =~ s{.*?<body [^>]+>}{}s;
36          $body =~ s{</body>\s*</html>\s*$}{};          $body =~ s{</body>\s*</html>\s*$}{};
37          $body =~ s!%3A%3A!::!g;          $body =~ s!%3A%3A!::!g;
38          $body =~ s{<a href="http://search\.cpan\.org/perldoc\?($my_classes)"([^>]*)>}{<a href="/$1"$2>}g;  #       $body =~ s{<a href="http://search\.cpan\.org/perldoc\?($my_classes)"([^>]*)>}{<a href="/$1"$2>}g;
39          $body =~ s{<a href="http://(search\.cpan\.org)/([^"]+)"([^>]*)>}{<a target="$1" href="http://$1/$2"$3>}g;          $body =~ s{<a href="http://(search\.cpan\.org/perldoc\?)([^"]+)"([^>]*)>([^<]+)<([^>]+)>}{<a href="/$2"$3>$4<$5><sup><a target="$1" title="CPAN" style="text-decoration: none" href="http://$1$2"$3>&loz;<$5></sup>}g;
40          $body =~ s!</li>\n\t<ul>!<ul>!;          $body =~ s!</li>\n\t<ul>!<ul>!;
41          $body =~ s!</ul>!</ul></li>!;          $body =~ s!</ul>!</ul></li>!;
42          $body =~ s!<p></p>!!;          $body =~ s!<p></p>!!;
43          $body =~ s!__index__!index!g;          $body =~ s!__index__!index!g;
44            $self->title( $class );
45          return $body;          return $body;
46    
47  }  }
48    
49  1;  1;
Legend:
Removed from v.344  
changed lines
  Added in v.691
  ViewVC Help
Powered by ViewVC 1.1.26