From 4ca352235e29561ce6449c72fe3e1acc23efb1d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hinrik=20=C3=96rn=20Sigur=C3=B0sson?= Date: Thu, 23 Jul 2009 14:38:17 +0000 Subject: [PATCH 1/3] Rename -l/--only option to -l/--locate --- Changes | 3 +++ lib/App/Grok.pm | 2 +- script/grok | 2 +- 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 96df04a..bd9c0c3 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +0.15 + - Rename -l/--only option to -l/--locate + 0.14 Fri Jul 24 09:20:07 GMT 2009 - Remove Module::Install::AuthorRequires for now, it's not working right - Make Win32::Console::ANSI optional diff --git a/lib/App/Grok.pm b/lib/App/Grok.pm index dc4251b..ee50005 100644 --- a/lib/App/Grok.pm +++ b/lib/App/Grok.pm @@ -73,7 +73,7 @@ sub _get_options { 'F|file=s' => \$opt{file}, 'h|help' => sub { pod2usage(1) }, 'i|index' => \$opt{index}, - 'l|only' => \$opt{only}, + 'l|locate' => \$opt{locate}, 'o|output=s' => \($opt{output} = $GOT_ANSI ? 'ansi' : 'text'), 'T|no-pager' => \$opt{no_pager}, 'u|unformatted' => sub { $opt{output} = 'pod' }, diff --git a/script/grok b/script/grok index b393ddf..00b698c 100755 --- a/script/grok +++ b/script/grok @@ -22,7 +22,7 @@ B -F FILE, --file=FILE A file to read Pod from -h, --help Print this help message -i, --index Print index of things grok knows about - -l, --only Only print the path to the target file + -l, --locate Locate the target file -o FORMAT, --output=FORMAT The output format, ansi/text/xhtml/pod -T, --no-pager Send output to STDOUT without any pager -u, --unformatted Print unformatted Pod output From 625d117d216db17cded330ac5bf11dab31ca2c13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hinrik=20=C3=96rn=20Sigur=C3=B0sson?= Date: Thu, 23 Jul 2009 14:29:08 +0000 Subject: [PATCH 2/3] Move parsers to App::Grok::Parser::* --- Changes | 1 + MANIFEST | 4 ++-- lib/App/Grok.pm | 8 ++++---- lib/App/Grok/{ => Parser}/Pod5.pm | 4 ++-- lib/App/Grok/{ => Parser}/Pod6.pm | 4 ++-- t/01_compile.t | 4 ++-- t/02_source/01_pod5.t | 4 ++-- t/02_source/02_pod6.t | 4 ++-- 8 files changed, 17 insertions(+), 16 deletions(-) rename lib/App/Grok/{ => Parser}/Pod5.pm (95%) rename lib/App/Grok/{ => Parser}/Pod6.pm (95%) diff --git a/Changes b/Changes index bd9c0c3..cba5bda 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,6 @@ 0.15 - Rename -l/--only option to -l/--locate + - Move parsers to the App::Grok::Parser:: namespace 0.14 Fri Jul 24 09:20:07 GMT 2009 - Remove Module::Install::AuthorRequires for now, it's not working right diff --git a/MANIFEST b/MANIFEST index 11a5709..3a39932 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,7 +1,7 @@ script/grok lib/App/Grok.pm -lib/App/Grok/Pod5.pm -lib/App/Grok/Pod6.pm +lib/App/Grok/Parser/Pod5.pm +lib/App/Grok/Parser/Pod6.pm p6/grok Makefile.PL MANIFEST diff --git a/lib/App/Grok.pm b/lib/App/Grok.pm index ee50005..9b18eda 100644 --- a/lib/App/Grok.pm +++ b/lib/App/Grok.pm @@ -205,10 +205,10 @@ sub detect_source { if ($first_pod =~ /^=(?:pod|head\d+|over)$/ || $contents =~ /^=cut\b/m) { - return 'App::Grok::Pod5'; + return 'App::Grok::Parser::Pod5'; } else { - return 'App::Grok::Pod6'; + return 'App::Grok::Parser::Pod6'; } } @@ -267,7 +267,7 @@ sub render_target { my $functions = $self->read_functions(); if (defined $functions->{$target}) { my ($func, $body) = @{ $functions->{$target} }; - my $renderer = 'App::Grok::Pod5'; + my $renderer = 'App::Grok::Parser::Pod5'; eval "require $renderer"; die $@ if $@; my $content = "=head1 $func\n\n$body"; @@ -277,7 +277,7 @@ sub render_target { my $entries = $self->read_table(); if (defined $entries->{$target}) { my $content = $entries->{$target}; - my $renderer = 'App::Grok::Pod5'; + my $renderer = 'App::Grok::Parser::Pod5'; eval "require $renderer"; die $@ if $@; return $renderer->new->render_string($content, $output); diff --git a/lib/App/Grok/Pod5.pm b/lib/App/Grok/Parser/Pod5.pm similarity index 95% rename from lib/App/Grok/Pod5.pm rename to lib/App/Grok/Parser/Pod5.pm index 2283208..349eb0c 100644 --- a/lib/App/Grok/Pod5.pm +++ b/lib/App/Grok/Parser/Pod5.pm @@ -1,4 +1,4 @@ -package App::Grok::Pod5; +package App::Grok::Parser::Pod5; use strict; use warnings; @@ -48,7 +48,7 @@ sub render_string { =head1 NAME -App::Grok::Pod5 - A Pod 5 backend for grok +App::Grok::Parser::Pod5 - A Pod 5 backend for grok =head1 METHODS diff --git a/lib/App/Grok/Pod6.pm b/lib/App/Grok/Parser/Pod6.pm similarity index 95% rename from lib/App/Grok/Pod6.pm rename to lib/App/Grok/Parser/Pod6.pm index 97d5b49..64ff48e 100644 --- a/lib/App/Grok/Pod6.pm +++ b/lib/App/Grok/Parser/Pod6.pm @@ -1,4 +1,4 @@ -package App::Grok::Pod6; +package App::Grok::Parser::Pod6; # blows up if we use strict before this, damn source filter use Perl6::Perldoc::Parser; @@ -43,7 +43,7 @@ sub render_string { =head1 NAME -App::Grok::Pod6 - A Pod 6 backend for grok +App::Grok::Parser::Pod6 - A Pod 6 backend for grok =head1 METHODS diff --git a/t/01_compile.t b/t/01_compile.t index 7516592..e80e812 100644 --- a/t/01_compile.t +++ b/t/01_compile.t @@ -3,6 +3,6 @@ use warnings; use Test::More tests => 4; use Test::Script; use_ok('App::Grok'); -use_ok('App::Grok::Pod5'); -use_ok('App::Grok::Pod6'); +use_ok('App::Grok::Parser::Pod5'); +use_ok('App::Grok::Parser::Pod6'); script_compiles_ok('script/grok', 'grok compiles'); diff --git a/t/02_source/01_pod5.t b/t/02_source/01_pod5.t index c67a2de..8ac7cb8 100644 --- a/t/02_source/01_pod5.t +++ b/t/02_source/01_pod5.t @@ -2,10 +2,10 @@ use strict; use warnings; use File::Spec::Functions 'catfile'; use Test::More tests => 4; -use App::Grok::Pod5; +use App::Grok::Parser::Pod5; my $pod = catfile('t_source', 'basic5.pod'); -ok(my $render = App::Grok::Pod5->new(), 'Constructed renderer object'); +ok(my $render = App::Grok::Parser::Pod5->new(), 'Constructed renderer object'); my $text = $render->render_file($pod, 'text'); my $ansi = $render->render_file($pod, 'ansi'); diff --git a/t/02_source/02_pod6.t b/t/02_source/02_pod6.t index d2a925c..206167a 100644 --- a/t/02_source/02_pod6.t +++ b/t/02_source/02_pod6.t @@ -2,10 +2,10 @@ use strict; use warnings; use File::Spec::Functions 'catfile'; use Test::More tests => 4; -use App::Grok::Pod6; +use App::Grok::Parser::Pod6; my $pod = catfile('t_source', 'basic.pod'); -ok(my $render = App::Grok::Pod6->new(), 'Constructed renderer object'); +ok(my $render = App::Grok::Parser::Pod6->new(), 'Constructed renderer object'); my $text = $render->render_file($pod, 'text'); my $ansi = $render->render_file($pod, 'ansi'); From b007a4b19394b61cf629e72479036c3e548cfa82 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hinrik=20=C3=96rn=20Sigur=C3=B0sson?= Date: Fri, 24 Jul 2009 10:37:31 +0000 Subject: [PATCH 3/3] Move all resource backends to App::Grok::Resource::* --- Changes | 1 + MANIFEST | 5 + lib/App/Grok.pm | 272 ++++++----------------------- lib/App/Grok/Parser/Pod5.pm | 20 ++- lib/App/Grok/Resource/File.pm | 76 ++++++++ lib/App/Grok/Resource/Functions.pm | 177 +++++++++++++++++++ lib/App/Grok/Resource/Spec.pm | 115 ++++++++++++ lib/App/Grok/Resource/Table.pm | 88 ++++++++++ lib/App/Grok/Resource/u4x.pm | 66 +++++++ t/03_opts/02_output.t | 2 +- 10 files changed, 602 insertions(+), 220 deletions(-) create mode 100644 lib/App/Grok/Resource/File.pm create mode 100644 lib/App/Grok/Resource/Functions.pm create mode 100644 lib/App/Grok/Resource/Spec.pm create mode 100644 lib/App/Grok/Resource/Table.pm create mode 100644 lib/App/Grok/Resource/u4x.pm diff --git a/Changes b/Changes index cba5bda..1a778d6 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,7 @@ 0.15 - Rename -l/--only option to -l/--locate - Move parsers to the App::Grok::Parser:: namespace + - Move all resource backends to App::Grok::Resource::* 0.14 Fri Jul 24 09:20:07 GMT 2009 - Remove Module::Install::AuthorRequires for now, it's not working right diff --git a/MANIFEST b/MANIFEST index 3a39932..82417ad 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2,6 +2,11 @@ script/grok lib/App/Grok.pm lib/App/Grok/Parser/Pod5.pm lib/App/Grok/Parser/Pod6.pm +lib/App/Grok/Resource/File.pm +lib/App/Grok/Resource/Functions.pm +lib/App/Grok/Resource/Spec.pm +lib/App/Grok/Resource/Table.pm +lib/App/Grok/Resource/u4x.pm p6/grok Makefile.PL MANIFEST diff --git a/lib/App/Grok.pm b/lib/App/Grok.pm index 9b18eda..07d4629 100644 --- a/lib/App/Grok.pm +++ b/lib/App/Grok.pm @@ -2,9 +2,12 @@ package App::Grok; use strict; use warnings; +use App::Grok::Resource::File qw<:ALL>; +use App::Grok::Resource::Functions qw<:ALL>; +use App::Grok::Resource::Spec qw<:ALL>; +use App::Grok::Resource::Table qw<:ALL>; +use App::Grok::Resource::u4x qw<:ALL>; use Config qw<%Config>; -use File::ShareDir qw; -use File::Spec::Functions qw; use File::Temp qw; use IO::Interactive qw; use Getopt::Long qw<:config bundling>; @@ -16,7 +19,7 @@ my %opt; our $GOT_ANSI; BEGIN { - if ($^O ne 'Win32') { + if ($^O eq 'Win32') { eval { require Win32::Console::ANSI; $GOT_ANSI = 1; @@ -38,17 +41,24 @@ sub run { $self->_get_options(); if ($opt{index}) { - print join("\n", $self->target_index()) . "\n"; + my @index = $self->target_index(); + print "$_\n" for @index; return; } my $target = defined $opt{file} ? $opt{file} : $ARGV[0]; if ($opt{only}) { - my $file = $opt{file}; - $file = $self->find_target_file($target) if !defined $file; - die "No matching file found for target '$target'\n" if !defined $file; - print $file, "\n"; + if (defined $opt{file}) { + print file_locate($opt{file}), "\n"; + } + else { + my $file = $self->locate_target(); + defined $file + ? print $file, "\n" + : die "Target file not found\n"; + ; + } } else { my $rendered; @@ -88,123 +98,38 @@ sub _get_options { return; } -# functions from synopsis 29 -sub read_functions { - my ($self) = @_; - - return $self->{functions} if defined $self->{functions}; - - my %functions; - my $S29_file = catfile(dist_dir('Perl6-Doc'), 'Synopsis', 'S29-functions.pod'); - - ## no critic (InputOutput::RequireBriefOpen) - open my $S29, '<', $S29_file or die "Can't open '$S29_file': $!"; - - # read until you find 'Function Packages' - until (<$S29> =~ /Function Packages/) {} - - # parse the rest of S29 looking for Perl6 function documentation - my $function_name; - while (my $line = <$S29>) { - if (my ($directive, $title) = $line =~ /^=(\S+) +(.+)/) { - if ($directive eq 'item') { - # Found Perl6 function name - if (my ($reference) = $title =~ /-- (see S\d+.*)/) { - # one-line entries - (my $func = $title) =~ s/^(\S+).*/$1/; - $functions{$func} = $reference; - } - else { - $function_name = $title; - } - } - else { - $function_name = undef; - } - } - elsif ($function_name) { - # Adding documentation to the function name - $functions{$function_name} .= $line; - } - } - - my %sanitized; - while (my ($func, $body) = each %functions) { - $sanitized{$func} = [$func, $body] if $func !~ /\s/; - - if ($func =~ /,/) { - my @funcs = split /,\s+/, $func; - $sanitized{$_} = [$func, $body] for @funcs; - } - } - - $self->{functions} = \%sanitized; - return $self->{functions}; -} - -sub read_table { - my ($self) = @_; - - return $self->{table} if defined $self->{table}; - - my %table; - my $table_file = catfile(dist_dir('Perl6-Doc'), 'table_index.pod'); - - ## no critic (InputOutput::RequireBriefOpen) - open my $table_handle, '<', $table_file or die "Can't open '$table_file': $!"; - - my $entry; - while (my $line = <$table_handle>) { - $entry = $1 if $line =~ /^=head2 C<<< (.+) >>>$/; - $table{$entry} .= $line if defined $entry; - } - - $self->{table} = \%table; - return \%table; -} - sub target_index { my ($self) = @_; - - my @index; - my %docs = map { - substr($_, 0, 1) => catdir(dist_dir('Perl6-Doc'), $_) - } qw; - - while (my ($type, $dir) = each %docs) { - my @parts = map { (splitpath($_))[2] } glob "$dir/*.pod"; - s/\.pod$// for @parts; - push @index, @parts; - } + my %index; + @index{table_index()} = 1; + @index{spec_index()} = 1; + @index{func_index()} = 1; + @index{u4x_index()} = 1; + return keys %index; +} - # synopsis 32 - my $S32_dir = catdir($docs{S}, 'S32-setting-library'); - my @sections = map { (splitpath($_))[2] } glob "$S32_dir/*.pod"; - s/\.pod$// for @sections; - push @index, map { "S32-$_" } @sections; +sub locate_target { + my ($self, $target) = @_; - # functions from synopsis 29 - push @index, sort keys %{ $self->read_functions() }; + my $found = u4x_locate($target); + $found = func_locate($target) if !defined $found; + $found = spec_locate($target) if !defined $found; + $found = table_locate($target) if !defined $found; + $found = file_locate($target) if !defined $found; - # entries from the Perl 6 Table Index - push @index, sort keys %{ $self->read_table() }; - - return @index; + return $found if defined $found; + return; } sub detect_source { - my ($self, $file) = @_; - - open my $handle, '<', $file or die "Can't open $file"; - my $contents = do { local $/ = undef; scalar <$handle> }; - close $handle; + my ($self, $target) = @_; - $contents =~ s/.*^=encoding\b.*$//m; # skip over =encoding - my ($first_pod) = $contents =~ /^(=\S+)/m; + $target =~ s/.*^=encoding\b.*$//m; # skip over =encoding + my ($first_pod) = $target =~ /^(=\S+)/m; return if !defined $first_pod; # no Pod found if ($first_pod =~ /^=(?:pod|head\d+|over)$/ - || $contents =~ /^=cut\b/m) { + || $target =~ /^=cut\b/m) { return 'App::Grok::Parser::Pod5'; } else { @@ -212,92 +137,32 @@ sub detect_source { } } -sub find_target_file { - my ($self, $arg) = @_; - - my $target = $self->find_perl6_doc($arg); - $target = $self->find_module_or_program($arg) if !defined $target; - - return if !defined $target; - return $target; -} - -sub find_perl6_doc { - my ($self, $doc) = @_; - - my $dist = dist_dir('Perl6-Doc'); - return catfile($dist, 'table_index.pod') if $doc eq 'table_index'; - - my %docs = map { - substr($_, 0, 1) => catdir($dist, $_) - } qw; - - # S32 is split up, need to special-case it - if (my ($section) = $doc =~ /^S32-(\S+)$/i) { - my $S32_dir = catdir($docs{S}, 'S32-setting-library'); - my @sections = map { (splitpath($_))[2] } glob "$S32_dir/*.pod"; - my $found = first { /^$section/i } @sections; - - if (defined $found) { - return catfile($S32_dir, $found); - } - } - elsif (my ($type) = $doc =~ /^(\w)\d+/i) { - my @parts = map { (splitpath($_))[2] } glob "$docs{uc $type}/*.pod"; - my $found = first { /\Q$doc/i } @parts; - - return if !defined $found; - return catfile($docs{uc $type}, $found); - } - - return; -} - -sub find_module_or_program { - my ($self, $file) = @_; - - # TODO: do a grand search - return $file if -e $file; - return; -} - sub render_target { my ($self, $target, $output) = @_; - my $functions = $self->read_functions(); - if (defined $functions->{$target}) { - my ($func, $body) = @{ $functions->{$target} }; - my $renderer = 'App::Grok::Parser::Pod5'; - eval "require $renderer"; - die $@ if $@; - my $content = "=head1 $func\n\n$body"; - return $renderer->new->render_string($content, $output); - } - - my $entries = $self->read_table(); - if (defined $entries->{$target}) { - my $content = $entries->{$target}; - my $renderer = 'App::Grok::Parser::Pod5'; - eval "require $renderer"; - die $@ if $@; - return $renderer->new->render_string($content, $output); - } - - my $file = $self->find_target_file($target); - if (defined $file) { - return $self->render_file($file, $output); - } + my $found = u4x_fetch($target); + $found = func_fetch($target) if !defined $found; + $found = spec_fetch($target) if !defined $found; + $found = table_fetch($target) if !defined $found; + $found = file_fetch($target) if !defined $found; - return; + my $parser = $self->detect_source($found); + eval "require $parser"; + die $@ if $@; + return $parser->new->render_string($found, $output); } sub render_file { my ($self, $file, $output) = @_; - my $renderer = $self->detect_source($file); - eval "require $renderer"; + open my $handle, '<', $file or die "Can't open $file: $!\n"; + my $pod = do { local $/ = undef; scalar <$handle> }; + + my $parser = $self->detect_source($pod); + close $handle; + eval "require $parser"; die $@ if $@; - return $renderer->new->render_file($file, $output); + return $parser->new->render_string($pod, $output); } sub _print { @@ -356,39 +221,16 @@ program does. Takes no arguments. Takes no arguments. Returns a list of all the targets known to C. -=head2 C - -Takes no arguments. Returns a hash reference of all function documentation -from Synopsis 29. There will be a key for every function, with the value being -a Pod snippet from Synopsis 29. - -=head2 C - -Takes no arguments. Returns a hash reference of all entries in the -I. Keys are the entry names, values are Pod snippets. - =head2 C Takes a filename as an argument. Returns the name of the appropriate C class to parse it. Returns nothing if the file doesn't contain any Pod. -=head2 C - -Takes a valid C target as an argument. If found, it will return a path -to a matching file, otherwise it returns nothing. - -=head2 C - -Takes the name (or a substring of a name) of a Synopsis as an argument. -Returns a path to a matching file if one is found, otherwise returns nothing. -B this method is called by L|/find_target>. - -=head2 C +=head2 C -Takes the name of a module or a program. Returns a path to a matching file -if one is found, otherwise returns nothing. B this doesn't do anything -yet. +Takes a target name as an argument. Returns the path to the target, or nothing +if the target is not recognized. =head2 C diff --git a/lib/App/Grok/Parser/Pod5.pm b/lib/App/Grok/Parser/Pod5.pm index 349eb0c..39f9e67 100644 --- a/lib/App/Grok/Parser/Pod5.pm +++ b/lib/App/Grok/Parser/Pod5.pm @@ -2,6 +2,7 @@ package App::Grok::Parser::Pod5; use strict; use warnings; +use File::Temp qw; our $VERSION = '0.14'; @@ -25,12 +26,23 @@ sub render_file { eval "require $form"; die $@ if $@; - my $pod = ''; - open my $out_fh, '>', \$pod or die "Can't open output filehandle: $!"; - binmode $out_fh, ':utf8' if $form ne 'Pod::Perldoc::ToPod'; + my $done = ''; + ## no critic (InputOutput::RequireBriefOpen) + open my $out_fh, '>', \$done or die "Can't open output filehandle: $!"; + + if ($form eq 'Pod::Perldoc::ToPod') { + my ($temp_fh, $temp) = tempfile(); + my $pod = do { local $/ = undef; scalar <$file> }; + print $temp_fh $pod; + $file = $temp; + } + else { + binmode $out_fh, ':utf8' if $form ne 'Pod::Perldoc::ToPod'; + } + $form->new->parse_from_file($file, $out_fh); close $out_fh; - return $pod; + return $done; } sub render_string { diff --git a/lib/App/Grok/Resource/File.pm b/lib/App/Grok/Resource/File.pm new file mode 100644 index 0000000..2f44b6e --- /dev/null +++ b/lib/App/Grok/Resource/File.pm @@ -0,0 +1,76 @@ +package App::Grok::Resource::File; + +use strict; +use warnings; + +our $VERSION = '0.14'; +use base qw(Exporter); +our @EXPORT_OK = qw(file_index file_fetch file_locate); +our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] ); + +sub file_fetch { + my ($file) = @_; + + # TODO: at some point we'll search through $PERL6LIB, but for now + # we only accept a concrete path + + if (-f $file) { + open my $handle, '<', $file or die "Can't open $file: $!"; + my $pod = do { local $/ = undef; scalar <$handle> }; + close $handle; + return $pod; + } + + return; +} + +sub file_index { + # this might recurse through $PERL6LIB or something at some point + return; +} + +sub file_locate { + my ($file) = @_; + + return $file if -f $file; + return; +} + +1; +=head1 NAME + +App::Grok::Resource::File - Standard file resource for grok + +=head1 SYNOPSIS + + use strict; + use warnings; + use App::Grok::Resource::File qw<:ALL>; + + # this will return everything in $PERL6LIB sometime in the future + my @index = file_index(); + + # get a filehandle to the thing we want + my $handle = file_fetch('perlintro'); + +=head1 DESCRIPTION + +This resource finds arbitrary documentation on the filesystem. + +=head1 METHODS + +=head2 C + +This method doesn't return anything useful yet. + +=head2 C + +Takes a module name, program name, or Pod page name. Since the details of +C<$PERL6LIB> are still fuzzy, it currently just returns the contents of +the supplied file. + +=head2 C + +Returns the filename given if it is a real file. Not very useful. + +=cut diff --git a/lib/App/Grok/Resource/Functions.pm b/lib/App/Grok/Resource/Functions.pm new file mode 100644 index 0000000..91a8b08 --- /dev/null +++ b/lib/App/Grok/Resource/Functions.pm @@ -0,0 +1,177 @@ +package App::Grok::Resource::Functions; + +use strict; +use warnings; +use File::ShareDir qw; +use File::Spec::Functions qw; + +our $VERSION = '0.14'; +use base qw(Exporter); +our @EXPORT_OK = qw(func_index func_fetch func_locate); +our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] ); +use constant { + NAME => 0, + POD => 1, + FILE => 2, +}; + +my %functions; +my $syn_dir = catdir(dist_dir('Perl6-Doc'), 'Synopsis'); + +sub func_fetch { + my ($func) = @_; + _read_functions() if !%functions; + + return $functions{$func}[POD] if defined $functions{$func}; + return; +} + +sub func_index { + _read_functions() if !%functions; + return keys %functions; +} + +sub func_locate { + my ($func) = @_; + _read_functions() if !%functions; + return if !defined $functions{$func}; + return $functions{$func}[FILE]; +} + +## no critic (Subroutines::ProhibitExcessComplexity) +sub _read_functions { + my ($self) = @_; + + my $S29_file = catfile(dist_dir('Perl6-Doc'), 'Synopsis', 'S29-functions.pod'); + + ## no critic (InputOutput::RequireBriefOpen) + open my $S29, '<', $S29_file or die "Can't open '$S29_file': $!"; + + # read until you find 'Function Packages' + until (<$S29> =~ /Function Packages/) {} + + my (%S29_funcs, $func_name); + while (my $line = <$S29>) { + if (my ($directive, $title) = $line =~ /^=(\S+)(?: +(.+))?/) { + if ($directive eq 'item') { + # Found Perl6 function name + if (my ($reference) = $title =~ /-- (see S\d+.*)/) { + # one-line entries + (my $func = $title) =~ s/^(\S+).*/$1/; + $S29_funcs{$func} = $reference; + } + else { + $title =~ s/\(.*\)//; + $func_name = $title; + } + } + else { + $func_name = undef; + } + } + elsif ($func_name) { + # Adding documentation to the function name + $S29_funcs{$func_name} .= $line; + } + } + + my %S29_sanitized; + while (my ($func, $body) = each %S29_funcs) { + $body = "=head2 C<<< $func >>>\n$body"; + $S29_sanitized{$func} = [$func, $body, $S29_file] if $func !~ /\s/; + + if ($func =~ /,/) { + my @funcs = split /,\s+/, $func; + $S29_sanitized{$_} = [$func, $body, $S29_file] for @funcs; + } + } + + %functions = %S29_sanitized; + + # read S32 + my $S32_dir = catdir($syn_dir, 'S32-setting-library'); + my @sections = map { (splitpath($_))[2] } glob "$S32_dir/*.pod"; + $_ = catdir($S32_dir, $_) for @sections; + + for my $section (@sections) { + ## no critic (InputOutput::RequireBriefOpen) + open my $handle, '<', $section or die "Can't open $section: $!"; + + my @new_func; + while (my $line = <$handle>) { + if (my ($directive, $title) = $line =~ /^=(\S+) +(.+)/) { + if (defined $new_func[NAME]) { + my $name = $new_func[NAME]; + + # S32 only overwrites S29 if the new definition is wordier + if (!defined $functions{$name} || + length $new_func[POD] > length $functions{$name}[POD]) { + $functions{$new_func[NAME]} = [@new_func]; + } + @new_func = (); + } + if ($directive eq 'item') { + $title =~ s/.*?method\s*//; + $title =~ s/^(\S+)\s*\(.*/$1/; + if ($title =~ /^\S+$/) { + $new_func[NAME] = $title; + $new_func[POD] = "=head2 C<<< $title >>>\n"; + $new_func[FILE] = $section; + } + } + } + elsif (defined $new_func[FILE]) { + # Adding documentation to the function name + $new_func[POD] .= $line; + #warn "new_func is now $new_func[1]\n"; + } + } + + close $handle; + } + + return; +} + +1; +=head1 NAME + +App::Grok::Resource::Functions - S29/S32 functions resource for grok + +=head1 SYNOPSIS + + use strict; + use warnings; + use App::Grok::Resource::Functions qw<:ALL>; + + # a list of all functions + my @index = func_index(); + + # documentation for a specific functions + my $pod = func_fetch('split'); + + # the file where the function was found + my $file = func_locate('split'); + +=head1 DESCRIPTION + +This resource reads Synopses 29 and 32, and allows you to look up the +functions therein. + +=head1 METHODS + +=head2 C + +Takes no arguments. Returns a list of all known function names. + +=head2 C + +Takes the name of a function as an argument. Returns the documentation for +that function. + +=head2 C + +Takes the same argument as L|/func_fetch>. Returns the path to +the Synopsis file where the given function was found. + +=cut diff --git a/lib/App/Grok/Resource/Spec.pm b/lib/App/Grok/Resource/Spec.pm new file mode 100644 index 0000000..b1de9f3 --- /dev/null +++ b/lib/App/Grok/Resource/Spec.pm @@ -0,0 +1,115 @@ +package App::Grok::Resource::Spec; + +use strict; +use warnings; +use File::ShareDir qw; +use File::Spec::Functions qw; + +our $VERSION = '0.14'; +use base qw(Exporter); +our @EXPORT_OK = qw(spec_index spec_fetch spec_locate); +our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] ); + +my %index; +my $dist_dir = dist_dir('Perl6-Doc'); +my %docs = map { + substr($_, 0, 1) => catdir($dist_dir, $_) +} qw; + +sub spec_fetch { + my ($topic) = @_; + return if $topic !~ /^\w\d\d/; + _build_index() if !%index; + + for my $doc (keys %index) { + if ($doc =~ /^$topic/i) { + open my $handle, '<', $index{$doc} or die "Can't open $index{$doc}: $!"; + my $pod = do { local $/ = undef; scalar <$handle> }; + close $handle; + return $pod; + } + } + return; +} + +sub spec_index { + _build_index() if !%index; + return keys %index; +} + +sub spec_locate { + my ($topic) = @_; + _build_index() if !%index; + + for my $doc (keys %index) { + return $index{$doc} if $doc =~ /^$topic/i; + } + + return; +} + +sub _build_index { + while (my ($type, $dir) = each %docs) { + for my $file (glob "$dir/*.pod") { + my $name = (splitpath($file))[2]; + $name =~ s/\.pod$//; + $index{$name} = $file; + } + } + + # synopsis 32 + my $S32_dir = catdir($docs{S}, 'S32-setting-library'); + for my $file (glob "$S32_dir/*.pod") { + my $name = (splitpath($file))[2]; + $name =~ s/\.pod$//; + $name = "S32-$name"; + $index{$name} = $file; + } + + return; +} + +1; +=head1 NAME + +App::Grok::Resource::Spec - Perl 6 specification resource for grok + +=head1 SYNOPSIS + + use strict; + use warnings; + use App::Grok::Resource::Spec qw<:ALL>; + + # list of all Synopsis, Exegeses, etc + my @index = spec_index(); + + # get the contents of Synopsis 02 + my $pod = spec_fetch('s02'); + + # filename containing S02 + my $file = spec_locate('s02'); + +=head1 DESCRIPTION + +This module the locates Apocalypses, Exegeses, Synopsis and magazine articles +distributed with L. + +=head1 METHODS + +=head2 C + +Doesn't take any arguments. Returns a list of all documents known to this +resource. + +=head2 C + +Takes the name of a document as an argument. It is case-insensitive and you +only need to specify the first three characters (though more are allowed), +e.g. C. Returns the Pod text of the document. + +=head2 C + +Takes the same argument as L|/spec_fetch>. Returns the filename +corresponding to the given document. + +=cut diff --git a/lib/App/Grok/Resource/Table.pm b/lib/App/Grok/Resource/Table.pm new file mode 100644 index 0000000..74af7f0 --- /dev/null +++ b/lib/App/Grok/Resource/Table.pm @@ -0,0 +1,88 @@ +package App::Grok::Resource::Table; + +use strict; +use warnings; +use File::ShareDir qw; +use File::Spec::Functions qw; + +our $VERSION = '0.14'; +use base qw(Exporter); +our @EXPORT_OK = qw(table_index table_fetch table_locate); +our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] ); + +my %table; +my $table_file = catfile(dist_dir('Perl6-Doc'), 'table_index.pod'); + +sub table_fetch { + my ($topic) = @_; + _build_table() if !%table; + + return $table{$topic} if defined $table{$topic}; + return; +} + +sub table_index { + _build_table() if !%table; + return keys %table; +} + +sub table_locate { + return $table_file; +} + +sub _build_table { + my ($self) = @_; + + ## no critic (InputOutput::RequireBriefOpen) + open my $table_handle, '<', $table_file or die "Can't open '$table_file': $!"; + + my $entry; + while (my $line = <$table_handle>) { + $entry = $1 if $line =~ /^=head2 C<<< (.+) >>>$/; + $table{$entry} .= $line if defined $entry; + } + + return; +} + +1; +=head1 NAME + +App::Grok::Resource::Table - Grok resource for the Perl 6 Table Index + +=head1 SYNOPSIS + + use strict; + use warnings; + use App::Grok::Resource::Table qw<:ALL>; + + # a list of all entries in the table + my @index = table_index(); + + # documentation for a table entry + my $pod = table_fetch('+'); + + # filename where the table entry was found + my $file = table_locate('+'); + +=head1 DESCRIPTION + +This resource looks up entries in the Perl 6 Table Index +(L. + +=head1 METHODS + +=head2 C + +Takes no arguments. Lists all entry names in the table. + +=head2 C + +Takes an entry name as an argument. Returns the documentation for it. + +=head2 C + +Takes an entry name as an argument. Returns the name of the file where it +was found. + +=cut diff --git a/lib/App/Grok/Resource/u4x.pm b/lib/App/Grok/Resource/u4x.pm new file mode 100644 index 0000000..6c5dc25 --- /dev/null +++ b/lib/App/Grok/Resource/u4x.pm @@ -0,0 +1,66 @@ +package App::Grok::Resource::u4x; + +use strict; +use warnings; + +our $VERSION = '0.14'; +use base qw(Exporter); +our @EXPORT_OK = qw(u4x_index u4x_fetch u4x_locate); +our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] ); + +my %index; + +sub u4x_fetch { + my ($topic) = @_; + + return $index{$topic} if defined $index{$topic}; + return; +} + +sub u4x_index { + return keys %index; +} + +sub u4x_locate { + my ($topic) = @_; + return __FILE__ if $index{$topic}; + return; +} + +1; +=head1 NAME + +App::Grok::Resource::u4x - u4x resource for grok + +=head1 SYNOPSIS + + use strict; + use warnings; + use App::Grok::Resource::u4x qw<:ALL>; + + # a list of all terms + my @index = u4x_index(); + + # documentation for a single term + my $pod = u4x_fetch('infix:<+>'); + +=head1 DESCRIPTION + +This resource looks maintains an index of syntax items that can be looked up. +See L. + +=head1 METHODS + +=head2 C + +Takes no arguments. Lists all syntax items. + +=head2 C + +Takes an syntax item as an argument. Returns the documentation for it. + +=head2 C + +Takes a syntax item as an argument. Returns the file where it was found. + +=cut diff --git a/t/03_opts/02_output.t b/t/03_opts/02_output.t index 2504ea9..c5d6b6a 100644 --- a/t/03_opts/02_output.t +++ b/t/03_opts/02_output.t @@ -37,4 +37,4 @@ like($pod5_ansi_long, qr/\e\[/, "Pod 5 ANSI has color codes (--output)"); isnt($pod5_text_long, $pod5_xhtml_long, "Pod 5 text and xhtml are different (--output)"); like($pod5_xhtml_long, qr/

/, "Pod 5 xhtml has

(--output)"); isnt($pod5_text_long, $pod5_pod_long, "Pod 5 text and pod are different (--output)"); -like($pod5_pod_long, qr/^=head1/m, "Pod 5 pod has =item (--output)"); +like($pod5_pod_long, qr/^=head1/m, "Pod 5 pod has =head1 (--output)");