Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

#!/usr/bin/perl
use 5.010;
use strict;
use Perinci::Sub::Util qw(err);
our $VERSION = '0.38'; # VERSION
eval { require Perinci::CmdLine };
if ($@) {
die "This script requires Perinci::CmdLine, please install it first.\n";
}
our %SPEC;
$SPEC{gen_doc} = {
v => 1.1,
args => {
url => {
summary => 'URL',
req => 1,
pos => 0,
schema => 'str*',
},
format => {
summary => 'Format',
schema => 'str',
},
},
};
sub gen_doc {
require File::Which;
require Perinci::Access;
state $pa = Perinci::Access->new;
my %args = @_;
# XXX schema
my $url = $args{url} or return [400, "Please specify url"];
$url = "pl:$url" if $url =~ m!^/!;
my $fname = $url; $fname =~ s!.+/!!;
my $format = $args{format} // "man";
$format = "text" unless
File::Which::which("pod2man") && File::Which::which("man");
my $res = $pa->request(info => $url);
return err(500, "Can't info", $res) unless $res->[0] == 200;
my $type = $res->[2]{type};
$res = $pa->request(meta => $url);
return err($res) unless $res->[0] == 200;
my $meta = $res->[2];
my $ometa = $res->[3]{orig_meta} // {};
my $doc;
if ($type eq 'function') {
# we want to document the original args_as & result_naked, not the
# wrapped-over-riap one
for (qw/args_as result_naked/) {
$meta->{$_} = $ometa->{$_} if defined $ometa->{$_};
}
if ($format eq 'man') {
$doc = Perinci::Sub::To::POD->new(meta=>$meta, name=>$fname);
$res = $doc->gen_doc;
[200, "OK", $res, {
"cmdline.page_result"=>1,
"cmdline.pager"=>"pod2man | man -l -"}];
} else {
$doc = Perinci::Sub::To::Text->new(meta=>$meta, name=>$fname);
$res = $doc->gen_doc;
[200, "OK", $res, {"cmdline.page_result"=>1}];
}
} elsif ($type eq 'package') {
$res = $pa->request(child_metas => $url);
return err(500, "Can't child_metas $url", $res) unless $res->[0] == 200;
my $cmetas = $res->[2];
my $ometas = $res->[3]{orig_metas} // {};
# we want to document the original args_as & result_naked, not the
# wrapped-over-riap one
for my $uri (keys %$cmetas) {
for (qw/args_as result_naked/) {
$cmetas->{$uri}{$_} = $ometas->{$uri}{$_}
if defined $ometas->{$uri}{$_};
}
}
if ($format eq 'man') {
$doc = Perinci::To::POD->new(
name=>$url, meta=>$meta, child_metas=>$cmetas);
$res = $doc->gen_doc;
[200, "OK", $res, {
"cmdline.page_result"=>1,
"cmdline.pager"=>"pod2man | man -l -"}];
} else {
$doc = Perinci::To::Text->new(
name=>$url, meta=>$meta, child_metas=>$cmetas);
$res = $doc->gen_doc;
[200, "OK", $res, {"cmdline.page_result"=>1}];
}
} else {
return [412, "Unsupported entity type '$type'"];
}
}
$ENV{LOG} //= 0; # speed up startup, but allow overriding
my $cmd = Perinci::CmdLine->new(
url => '/main/gen_doc',
);
delete $cmd->common_opts->{format};
delete $cmd->common_opts->{format_options};
$cmd->run;
# ABSTRACT: Display text/POD documentation of Riap function or package
# PODNAME: peri-doc
__END__
=pod
=encoding UTF-8
=head1 NAME
peri-doc - Display text/POD documentation of Riap function or package
=head1 VERSION
version 0.38
=head1 SYNOPSIS
From command-line:
% peri-doc /Some/Module/
% peri-doc --format=text https://example.com/api/some_func
% peri-doc --help
=head1 DESCRIPTION
This script will generate text/POD documentation for a Riap function or package.
=head1 SEE ALSO
Support other entity types in the future.
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/Perinci-To-Doc>.
=head1 SOURCE
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-To-Doc>
When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.
=head1 AUTHOR
Steven Haryanto <stevenharyanto@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Steven Haryanto.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut