File Coverage

blib/lib/Pod/Sub/Usage.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	7	8	87.5
condition	9	17	52.9
subroutine	9	9	100.0
pod	2	2	100.0
total	69	78	88.4

package Pod::Sub::Usage;

use Carp;
use 5.010;
use strict;
use warnings;

$Pod::Sub::Usage::VERSION = '0.02001';

use Exporter 'import';
our @EXPORT_OK = qw( sub2usage pod_text);
our %EXPORT_TAGS = (all => [@EXPORT_OK],);

sub sub2usage {
    my ($package, $sub) = @_;
    require Module::Locate;
    my $file = Module::Locate::locate($package ||= (caller 0)[0]) // (caller 0)[1];
    return print pod_text($file, $package, $sub);
}

sub pod_text {
    my $file    = shift;
    my $package = shift;
    my $sub     = shift // 'SYNOPSIS';
    open my $fh, '<:encoding(UTF-8)', $file || croak qq~Could not open: '$file'~;
    my $sub_header = _parse_file($fh, qr/^=(cut|head\d|over)\s+($sub|$package::$sub)/sxm);
    my $is_closed = close $fh;
    croak qq~Couldn't find '$sub' in: $file~ if !$sub_header || !$is_closed;
    return $sub_header;
}

sub _parse_file {
    my ($fh, $rex_start_head) = @_;
    my $found      = 0;
    my $sub_header = q//;
    while (my $row = <$fh>) {
        last if ($row =~ /^=(cut|head|over)/sxm && $found);
        if ($row =~ /$rex_start_head/sxm) {
            $found = 1;
            next;
        }
        if ($found) {
            chomp $row;
            $row =~ s/^=head\d\s+//sxm;
            $sub_header .= "$row\n";
        }
    }
    return $sub_header;
}

1;

__END__