The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

$orig_name

$parts[-1].$sub() -> Obj

Return the __POD__

$orig_name

Obj $sub Obj -> Obj

Return the __POD2__

        if (@{$value->{aliases}}) {
            $doc .= "\nAliases: " . join(
                ", ",
                map {
                    my $sub = $_;
                    $sub =~ s{([<>])}{E<$esc{$1}>}g;
                    lc($sub) eq uc($sub) ? "I<$sub()>" : "I<$sub>";
                  } @{$value->{aliases}}
              )
              . "\n";
        }

        $doc .= "\n=cut\n";

        $subs{$key}{doc} //= $doc;
    }

    my @keys = keys %subs;
    if ($#keys == -1) {
        warn "[!] No method found for module: $module\n";
        return;
    }

    my $pod_file = catfile(@parts) . '.pod';

    say "** Writing: $pod_file";

    my $pod_data = {};

    (-e $pod_file) && do {
        $pod_data = parse_pod_file($pod_file);
    };

    while (my ($key, $value) = each %subs) {

        my $alias;
        if (exists $value->{aliases}) {
            $alias = first {
                exists($pod_data->{$_})
            }
            @{$value->{aliases}};
        }

        if ($alias // exists($pod_data->{$value->{name}})) {
            my $doc = $pod_data->{$alias // $value->{name}};
            if (not $doc =~ /^Return the$/m) {
                $subs{$key}{doc} = $doc;
            }
        }
    }

    open my $fh, '>', $pod_file;

    my $header = $pod_data->{__HEADER__};

    if (not defined($header) or $header =~ /^This object is \.\.\.$/m) {
        $header = <<"HEADER";

NAME

$module

DESCRIPTION

This object is ...

SYNOPSIS

var obj = $parts[-1].new(...);

HEADER

        my @isa = @{exists($mod_methods->{ISA}) ? $mod_methods->{ISA} : []};

        if (@isa) {
            $header .= <<'HEADER';

INHERITS

Inherits methods from:

HEADER

            $header .= join("\n", map { "\t* $_" } @isa);
            $header .= "\n\n";
        }

        $header .= <<"HEADER";
=head1 METHODS

HEADER }

    # Print the header
    print {$fh} $header;

    # Print the methods
    foreach my $method (
        sort {
                 (lc($a->{name} =~ tr/_//dr) cmp lc($b->{name} =~ tr/_//dr))
              || (lc($a->{name}) cmp lc($b->{name}))
              || ($a->{name} cmp $b->{name})
        } values %subs
      ) {
        print {$fh} $method->{doc};
    }
}