diff options
author | James E Keenan <jkeenan@cpan.org> | 2021-03-16 22:15:56 +0000 |
---|---|---|
committer | James E Keenan <jkeenan@cpan.org> | 2021-07-06 01:08:03 +0000 |
commit | 193189d2f47ded0eeb4cdc4223082e1fc7e23adb (patch) | |
tree | f7ecd2ccee4fa75b6d06d6de36718c15226187b9 /ext/Pod-Html | |
parent | 8405b171b4f19b2f4cc493ef3ef6871c2bd5147f (diff) | |
download | perl-193189d2f47ded0eeb4cdc4223082e1fc7e23adb.tar.gz |
Introduce generate_cache() and identify_input()
Further encapsulation of code to improve readability.
Signed-off-by: James E Keenan <jkeenan@cpan.org>
Diffstat (limited to 'ext/Pod-Html')
-rw-r--r-- | ext/Pod-Html/lib/Pod/Html.pm | 103 |
1 files changed, 61 insertions, 42 deletions
diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 0ebbf2b879..253585b112 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -280,50 +280,10 @@ sub pod2html { # load or generate/cache %Pages unless (get_cache($globals)) { # generate %Pages - my $pwd = getcwd(); - chdir($globals->{Podroot}) || - die "$0: error changing to directory $globals->{Podroot}: $!\n"; - - # find all pod modules/pages in podpath, store in %Pages - # - callback used to remove Podroot and extension from each file - # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1) - Pod::Simple::Search->new->inc(0)->verbose($globals->{Verbose})->laborious(1) - ->callback(\&_save_page)->recurse($globals->{Recurse})->survey(@{$globals->{Podpath}}); - - chdir($pwd) || die "$0: error changing to directory $pwd: $!\n"; - - # cache the directory list for later use - warn "caching directories for later use\n" if $globals->{Verbose}; - open my $cache, '>', $globals->{Dircache} - or die "$0: error open $globals->{Dircache} for writing: $!\n"; - - print $cache join(":", @{$globals->{Podpath}}) . "\n$globals->{Podroot}\n"; - my $_updirs_only = ($globals->{Podroot} =~ /\.\./) && !($globals->{Podroot} =~ /[^\.\\\/]/); - foreach my $key (keys %Pages) { - if($_updirs_only) { - my $_dirlevel = $globals->{Podroot}; - while($_dirlevel =~ /\.\./) { - $_dirlevel =~ s/\.\.//; - # Assume $Pages{$key} has '/' separators (html dir separators). - $Pages{$key} =~ s/^[\w\s\-\.]+\///; - } - } - print $cache "$key $Pages{$key}\n"; - } - close $cache or die "error closing $globals->{Dircache}: $!"; + %Pages = generate_cache($globals, \%Pages); } - my $input; - unless (@ARGV && $ARGV[0]) { - if ($globals->{Podfile} and $globals->{Podfile} ne '-') { - $input = $globals->{Podfile}; - } else { - $input = '-'; # XXX: make a test case for this - } - } else { - $globals->{Podfile} = $ARGV[0]; - $input = *ARGV; - } + my $input = identify_input($globals); my $podtree = parse_input_for_podtree($globals, $input); $globals->{Title} = set_Title_from_podtree($globals, $podtree); @@ -419,6 +379,65 @@ sub refine_globals { return $globals; } +sub generate_cache { + my ($globals, $Pagesref) = @_; + my $pwd = getcwd(); + chdir($globals->{Podroot}) || + die "$0: error changing to directory $globals->{Podroot}: $!\n"; + + # find all pod modules/pages in podpath, store in %Pages + # - inc(0): do not prepend directories in @INC to search list; + # limit search to those in @{$globals->{Podpath}} + # - verbose: report (via 'warn') what search is doing + # - laborious: to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1) + # - callback: used to remove Podroot and extension from each file + # - recurse: go into subdirectories + # - survey: search for POD files in PodPath + my ($name2path, $path2name) = + Pod::Simple::Search->new->inc(0)->verbose($globals->{Verbose})->laborious(1) + ->callback(\&_save_page)->recurse($globals->{Recurse})->survey(@{$globals->{Podpath}}); + #print STDERR Data::Dumper::Dumper($name2path, $path2name) if ($globals->{Verbose}); + + chdir($pwd) || die "$0: error changing to directory $pwd: $!\n"; + + # cache the directory list for later use + warn "caching directories for later use\n" if $globals->{Verbose}; + open my $cache, '>', $globals->{Dircache} + or die "$0: error open $globals->{Dircache} for writing: $!\n"; + + print $cache join(":", @{$globals->{Podpath}}) . "\n$globals->{Podroot}\n"; + my $_updirs_only = ($globals->{Podroot} =~ /\.\./) && !($globals->{Podroot} =~ /[^\.\\\/]/); + foreach my $key (keys %{$Pagesref}) { + if($_updirs_only) { + my $_dirlevel = $globals->{Podroot}; + while($_dirlevel =~ /\.\./) { + $_dirlevel =~ s/\.\.//; + # Assume $Pagesref->{$key} has '/' separators (html dir separators). + $Pagesref->{$key} =~ s/^[\w\s\-\.]+\///; + } + } + print $cache "$key $Pagesref->{$key}\n"; + } + close $cache or die "error closing $globals->{Dircache}: $!"; + return %{$Pagesref}; +} + +sub identify_input { + my $globals = shift; + my $input; + unless (@ARGV && $ARGV[0]) { + if ($globals->{Podfile} and $globals->{Podfile} ne '-') { + $input = $globals->{Podfile}; + } else { + $input = '-'; # XXX: make a test case for this + } + } else { + $globals->{Podfile} = $ARGV[0]; + $input = *ARGV; + } + return $input; +} + sub parse_input_for_podtree { my ($globals, $input) = @_; # set options for input parser |