view release on metacpan or  search on metacpan

htmlgen/FunctionalPerl/Htmlgen/Linking.pm  view on Meta::CPAN

#
# Copyright (c) 2014-2021 Christian Jaeger, copying@christianjaeger.ch
#
# This is free software, offered under either the same terms as perl 5
# or the terms of the Artistic License version 2 or the terms of the
# MIT License (Expat version). See the file COPYING.md that came
# bundled with this file.
#

=head1 NAME

FunctionalPerl::Htmlgen::Linking

=head1 SYNOPSIS

=head1 DESCRIPTION

Adding/changing links, currently:

- check whether <code> parts contain things that are either module
  names in our repository or on CPAN, if so link them.

- also, map <code> contents with map_code_body if applicable

- instead of linking non-markdown files locally, make them go to the
  Github repo

=head1 SEE ALSO

These are L<FunctionalPerl::Htmlgen::PXMLMapper>s

=head1 NOTE

This is alpha software! Read the status section in the package README
or on the L<website|http://functional-perl.org/>.

=cut

package FunctionalPerl::Htmlgen::Linking;

use strict;
use warnings;
use warnings FATAL => 'uninitialized';
use experimental "signatures";

use Sub::Call::Tail;

package FunctionalPerl::Htmlgen::Linking::Anchors {

    # add anchors

    use PXML::XHTML ":all";

    use FP::Struct [] => "FunctionalPerl::Htmlgen::PXMLMapper";

    sub match_element_names($self) { [qw(h1 h2 h3 h4)] }

    sub map_element ($self, $e, $uplist) {
        my $text = $e->text;
        $text =~ s/ /_/sg;
        A({ name => $text }, $e)
    }
    _END_
}

package FunctionalPerl::Htmlgen::Linking::code {
    use FP::List;
    use FP::Predicates;
    use FunctionalPerl::Htmlgen::PathUtil qw(path_diff);
    use PXML::XHTML ":all";
    use Chj::CPAN::ModulePODUrl 'perhaps_module_pod_url';
    use FP::Memoizing 'memoizing_to_dir';
    use FunctionalPerl::Indexing qw(identifierInfos_by_name);
    use FP::Carp;

    our $podurl_cache = ".ModulePODUrl-cache";
    mkdir $podurl_cache;

    # NOTE: ignores are handled further down, see $ignore_module_name
    *xmaybe_module_pod_url = memoizing_to_dir $podurl_cache, sub {
        print STDERR "perhaps_module_pod_url(@_)..";
        my @res = perhaps_module_pod_url @_;
        print STDERR "@res\n";
        wantarray ? @res : $res[-1] ## no critic
    };

    sub maybe_module_pod_url($v) {
        my $res;
        eval {
            $res = xmaybe_module_pod_url($v);
            1
        } || do {
            my $e         = $@;
            my $firstline = "$e";
            $firstline =~ s/\n.*//s;
            $firstline =~ m/Can't connect/i
                ? do {
                warn "could not look up module '$v': $firstline";
                return undef;
                }
                : die $e
        };
        $res
    }

    sub is_likely_class_name($str) {

        # If $str contains an underscore but no "::" then it's much
        # more likely to be a function or method name than a class
        # name:
        is_valid_class_name($str) and ($str =~ /::/ or not $str =~ /_/)
    }

    use FP::Struct [
        [\&is_string, "functional_perl_base_dir"],
        [\&is_array,  "static_ignore_names"]
    ] => "FunctionalPerl::Htmlgen::PXMLMapper";

    sub _ignore_module_name($self) {
        $self->{_ignore_module_name} //= do {
            my $ignore_module_name
                = identifierInfos_by_name($self->functional_perl_base_dir,
                instance_of("FunctionalPerl::Indexing::Subroutine"));

            for (@{ $self->static_ignore_names }) {
                push @{ $ignore_module_name->{$_} },
                    1;    # that is  not of the same type (Subroutine),
                          # but we just need a boolean.
            }