Add support for Perl 6 Table Index

Depend on Perl6::Doc 0.41 for this

Changes

@@ -1,3 +1,6 @@
+0.13
+    - Look up things from the Perl 6 Table Index
+
 0.12 Tue Jul 14 13:24:47 EDT 2009
     - Depend on latest Perl6::Perldoc::To::Ansi and Pod::Text::Ansi
       for a consistent look

MANIFEST

@@ -22,6 +22,7 @@ t/03_opts/06_index.t
 t/04_targets/01_file.t
 t/04_targets/02_synopsis.t
 t/04_targets/03_function.t
+t/04_targets/04_table.t
 t_source/basic.pod
 t_source/basic5.pod
 xt/perlcriticrc

Makefile.PL

@@ -17,7 +17,7 @@ requires       ('Getopt::Long'             => '2.33');
 requires       ('IO::Interactive'          => '0');
 requires       ('File::ShareDir'           => '0');
 requires       ('File::Temp'               => '0');
-requires       ('Perl6::Doc'               => '0.40');
+requires       ('Perl6::Doc'               => '0.41');
 requires       ('Perl6::Perldoc'           => '0.0.5');
 requires       ('Perl6::Perldoc::To::Ansi' => '0.07');
 requires       ('Pod::Text::Ansi'          => '0.03');

lib/App/Grok.pm

@@ -129,6 +129,27 @@ sub read_functions {
     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) = @_;
 
@@ -151,6 +172,9 @@ sub target_index {
 
     # functions from synopsis 29
     push @index, sort keys %{ $self->read_functions() };
+
+    # entries from the Perl 6 Table Index
+    push @index, sort keys %{ $self->read_table() };
 
     return @index;
 }
@@ -188,8 +212,11 @@ sub find_target_file {
 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_dir('Perl6-Doc'), $_)
+        substr($_, 0, 1) => catdir($dist, $_)
     } qw<Apocalypse Exegesis Magazine Synopsis>;
 
     # S32 is split up, need to special-case it
@@ -234,6 +261,15 @@ sub render_target {
         return $renderer->new->render_string($content, $output);
     }
 
+    my $entries = $self->read_table();
+    if (defined $entries->{$target}) {
+        my $content = $entries->{$target};
+        my $renderer = 'App::Grok::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);
@@ -311,7 +347,12 @@ Takes no arguments. Returns a list of all the targets known to C<grok>.
 
 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 snipped from Synopsis 29.
+a Pod snippet from Synopsis 29.
+
+=head2 C<read_table>
+
+Takes no arguments. Returns a hash reference of all entries in the
+I<Perl 6 Table Index>. Keys are the entry names, values are Pod snippets.
 
 =head2 C<detect_source>
 

script/grok

@@ -36,6 +36,9 @@ B<grok> <options> <target>
    * An Exegesis name ('e01', 'e02', 'e03')
    * An article name ('m01', 'm01-perl6-announcement', 'm02')
    * A function name from Synopsis 29
+   * An entry in the Perl 6 Table Index ('%', '!=', 'split')
+   * The Perl 6 Table Index itself ('table_index')
+   * A path to a file containing Pod ('/some/file.pod')
 
 =head1 DESCRIPTION
 

t/04_targets/04_table.t

@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+use File::Spec::Functions 'catfile';
+use Test::More tests => 2;
+
+my $grok = catfile('script', 'grok');
+
+my $fork = qx/$^X $grok chdir/;
+my $kill = qx/$^X $grok chop/;
+
+like($fork, qr/directory/, "Got chdir()");
+like($kill, qr/string/, "Got chop()");