view release on metacpan or  search on metacpan

lib/Statocles/App/Perldoc.pm  view on Meta::CPAN

    for my $glob ( @{ $self->modules } ) {
        %modules = (
            %modules,
            %{ Pod::Simple::Search->new->inc(0)->limit_re( qr{^$glob} )->survey( @dirs ) },
        );

        # Also check for exact matches, for strange extensions
        for my $dir ( @dirs ) {
            my @glob_parts = split /::/, $glob;
            my $path = Path::Tiny->new( $dir, @glob_parts );
            if ( $path->is_file ) {
                $modules{ $glob } = "$path";
            }
        }
    }


    #; use Data::Dumper;
    #; say Dumper \%modules;

    my @pages;
    for my $module ( keys %modules ) {

        my $path = $modules{ $module };
        #; use Data::Dumper;
        #; say Dumper $path;

        # Weave the POD before trying to make HTML
        my $pod = $self->weave
                ? $self->_weave_module( $path )
                : Path::Tiny->new( $path )->slurp
                ;

        my $parser = Pod::Simple::XHTML->new;
        $parser->perldoc_url_prefix( $pod_base );
        $parser->$_('') for qw( html_header html_footer );
        $parser->output_string( \(my $parser_output) );
        $parser->parse_string_document( $pod );
        #; say $parser_output;

        my $dom = Mojo::DOM->new( $parser_output );
        for my $node ( $dom->find( 'a[href]' )->each ) {
            my $href = $node->attr( 'href' );

            # Rewrite links for modules that we will be serving locally
            if ( grep { $href =~ /^$pod_base$_/ } @{ $self->modules } ) {
                my ( $module, $section ) = $href =~ /^$pod_base([^#]+)(?:\#(.*))?$/;
                my $url = $self->url( $self->_module_href( $module ) );
                $node->attr( href => $section ? join( "#", $url, $section ) : $url );
            }
            # Add rel="external" for remaining external links
            elsif ( $href =~ m{(?:[^:]+:)?//} ) {
                $node->attr( rel => 'external' );
            }

        }

        my $source_path = "$module/source.html";
        $source_path =~ s{::}{/}g;

        my ( @parts ) = split m{::}, $module;
        my @crumbtrail;
        for my $i ( 0..$#parts ) {
            my $trail_module = join "::", @parts[0..$i];
            if ( $modules{ $trail_module } ) {
                push @crumbtrail, {
                    text => $parts[ $i ],
                    href => $self->url( $self->_module_href( $trail_module ) ),
                };
            }
            else {
                push @crumbtrail, {
                    text => $parts[ $i ],
                };
            }
        }

        my %page_args = (
            layout => $self->template( 'layout.html' ),
            template => $self->template( 'pod.html' ),
            title => $module,
            content => "$dom",
            app => $self,
            path => $self->_module_href( $module ),
            data => {
                source_path => $self->url( $source_path ),
                crumbtrail => \@crumbtrail,
            },
        );

        if ( $module eq $self->index_module ) {
            unshift @pages, Statocles::Page::Plain->new( %page_args );
	          $self->_highlight_page( $pages[0], 'pre > code' );
        }
        else {
            push @pages, Statocles::Page::Plain->new( %page_args );
	          $self->_highlight_page( $pages[-1], 'pre > code' );
        }

        # Add the source as a text file
        push @pages, Statocles::Page::Plain->new(
            path => $source_path,
            layout => $self->template( 'layout.html' ),
            template => $self->template( 'source.html' ),
            title => "$module (source)",
            content => Path::Tiny->new( $path )->slurp,
            app => $self,
            data => {
                doc_path => $self->url( $page_args{path} ),
                crumbtrail => \@crumbtrail,
            },
        );
        # unable to highlight source as source.html.ep uses <%== %> to escape html.
        # $self->_highlight_page( $pages[-1], 'pre' );
    }

    return @pages;
}

sub _highlight_page {
  my ( $self, $page, $sel ) = @_;