Perldoc::Server::Model::Pod - Catalyst Model

package Perldoc::Server::Model::Pod;

use strict;
use warnings;
use 5.010;
use parent 'Catalyst::Model';

use File::Slurp qw/slurp/;
use Memoize;
use Pod::Simple::Search;

memoize('section', NORMALIZER => sub { $_[1] });

sub ACCEPT_CONTEXT { 
  my ( $self, $c, @extra_arguments ) = @_; 
  bless { %$self, c => $c }, ref($self); 
}


sub pod {
  my ($self,$pod) = @_;
  
  if (my $file = $self->find($pod)) {
    return slurp($file);
  }
  
  return "=head1 Cannot find Pod for $pod";
}


sub find {
  my ($self,$pod) = @_;
  
  my @search_path = grep {/\w/} @{$self->{c}->config->{search_path}};
  return Pod::Simple::Search->new->inc(0)->find($pod, @search_path,map{"$_/pods"} @search_path);
}


sub title {
  my ($self,$page) = @_;
  state %name2title;
  
  unless (exists $name2title{$page}) {
    local $_ = $self->pod($page);
    if (/=head1 NAME\s*?[\n|\r](\S.*?)[\n|\r]\s*[\n|\r]/si or 
        /=head1 TITLE\s*?[\n|\r](\S.*?)[\n|\r]\s*[\n|\r]/si) {
      my $title = $1;
      if (defined $title) {
        $title =~ s/E<(.*?)>/&$1;/g;
        $title =~ s/[A-DF-Z]<(.*?)>/$1/g;
        $title =~ s/.*? -+\s+//;
        $title =~ s/\(\$.*?\$\)//;
        $name2title{$page} = $title;
      }
    }
  }
  
  return $name2title{$page};
}


sub section {
  my ($self, $page) = @_;
  
  foreach my $section ($self->{c}->model('Section')->list) {
    my @section_pages = $self->{c}->model('Section')->pages($section);
    if ($page ~~ @section_pages) {
      return $section;
    }
  }
  return;
}

1;