$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};
}
}