Permalink
Browse files

Support looking up functions from Synopsis 29

  • Loading branch information...
hinrik committed Jul 2, 2009
1 parent c7c1fe2 commit 5175433c00cb8af7344740f2f931718cd17c5a74
Showing with 176 additions and 31 deletions.
  1. +1 −0 Changes
  2. +1 −0 MANIFEST
  3. +116 −18 lib/App/Grok.pm
  4. +17 −2 lib/App/Grok/Pod5.pm
  5. +17 −2 lib/App/Grok/Pod6.pm
  6. +2 −1 script/grok
  7. +2 −2 t/02_source/01_pod5.t
  8. +2 −2 t/02_source/02_pod6.t
  9. +5 −4 t/03_opts/06_index.t
  10. +13 −0 t/04_targets/03_function.t
View
@@ -1,6 +1,7 @@
0.10
- Add 'pod' output format for Pod 5, and u-/--unformatted
- Rename -f/--format to -o/--output like perldoc(1)
- Support looking up functions from Synopsis 29
0.09 Wed Jul 1 17:05:31 GMT 2009
- Add some author tests (Pod, Perl::Critic, etc)
View
@@ -21,6 +21,7 @@ t/03_opts/05_no_pager.t
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_source/basic.pod
t_source/basic5.pod
xt/perlcriticrc
View
@@ -35,18 +35,24 @@ sub run {
return;
}
my $target = defined $opt{file}
? $opt{file}
: $self->find_target($ARGV[0])
;
die "No matching files found for target '$target'\n" if !-e $target;
my $target = defined $opt{file} ? $opt{file} : $ARGV[0];
if ($opt{only}) {
print "$target\n";
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";
}
else {
my $output = $self->render_file($target, $opt{output});
my $output;
if ($opt{file}) {
$output = $self->render_file($opt{file}, $opt{output});
}
else {
$output = $self->render_target($target, $opt{output});
}
die "Target '$target' not recognized\n" if !defined $output;
$self->_print($output);
}
@@ -63,12 +69,10 @@ sub _get_options {
'l|only' => \$opt{only},
'o|output=s' => \($opt{output} = 'ansi'),
'T|no-pager' => \$opt{no_pager},
'u|unformatted' => \$opt{unformatted},
'u|unformatted' => sub { $opt{output} = 'pod' },
'V|version' => sub { print "grok $VERSION\n"; exit },
) or pod2usage();
$opt{output} = 'pod' if $opt{unformatted};
if (!$opt{index} && !defined $opt{file} && !@ARGV) {
warn "Too few arguments\n";
pod2usage();
@@ -77,19 +81,79 @@ 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($self->{share_dir}, 'Spec', '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 target_index {
my ($self) = @_;
my $dir = catdir($self->{share_dir}, 'Spec');
my @index;
# synopses
my @synopses = map { (splitpath($_))[2] } glob "$dir/*.pod";
s/\.pod$// for @synopses;
push @index, @synopses;
# synopsis 32
my $S32_dir = catdir($dir, 'S32-setting-library');
my @sections = map { (splitpath($_))[2] } glob "$S32_dir/*.pod";
s/\.pod$// for @sections;
push @index, map { "S32-$_" } @sections;
s/\.pod$// for @index;
# functions from synopsis 29
push @index, keys %{ $self->read_functions() };
return @index;
}
@@ -112,7 +176,7 @@ sub detect_source {
}
}
sub find_target {
sub find_target_file {
my ($self, $arg) = @_;
my $target = $self->find_synopsis($arg);
@@ -150,7 +214,29 @@ sub find_module_or_program {
my ($self, $file) = @_;
# TODO: do a grand search
return $file;
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::Pod5';
eval "require $renderer";
die $@ if $@;
my $content = "=head1 $func\n\n$body";
return $renderer->new->render_string($content, $output);
}
my $file = $self->find_target_file($target);
if (defined $file) {
return $self->render_file($file, $output);
}
return;
}
sub render_file {
@@ -159,7 +245,7 @@ sub render_file {
my $renderer = $self->detect_source($file);
eval "require $renderer";
die $@ if $@;
return $renderer->new->render($file, $output);
return $renderer->new->render_file($file, $output);
}
sub _print {
@@ -213,13 +299,19 @@ program does. Takes no arguments.
Takes no arguments. Returns a list of all the targets known to C<grok>.
=head2 C<read_functions>
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.
=head2 C<detect_source>
Takes a filename as an argument. Returns the name of the appropriate
C<App::Grok::*> class to parse it. Returns nothing if the file doesn't contain
any Pod.
=head2 C<find_target>
=head2 C<find_target_file>
Takes a valid C<grok> target as an argument. If found, it will return a path
to a matching file, otherwise it returns nothing.
@@ -236,11 +328,17 @@ Takes the name of a module or a program. Returns a path to a matching file
if one is found, otherwise returns nothing. B<Note:> this doesn't do anything
yet.
=head2 C<render_target>
Takes two arguments, a target and the name of an output format. Returns a
string containing the rendered documentation, or nothing if the target is
unrecognized.
=head2 C<render_file>
Takes two arguments, a filename and the name of an output format. Returns
a string containing the rendered document. It will C<die> if there is an
error.
a string containing the rendered document. B<Note:> this method is called
by L<C<render_target>|/render_target>.
=head1 AUTHOR
View
@@ -17,7 +17,7 @@ sub new {
return bless \%self, $package;
}
sub render {
sub render_file {
my ($self, $file, $format) = @_;
my $form = $formatter{$format};
@@ -33,6 +33,15 @@ sub render {
return $pod;
}
sub render_string {
my ($self, $string, $format) = @_;
open my $handle, '<', \$string or die "Can't open input filehandle: $!";
my $result = $self->render_file($handle, $format);
close $handle;
return $result;
}
1;
=encoding UTF-8
@@ -47,12 +56,18 @@ App::Grok::Pod5 - A Pod 5 backend for grok
This is the constructor. It currently takes no arguments.
=head2 C<render>
=head2 C<render_file>
Takes two arguments, a filename and the name of an output format. Returns
a string containing the rendered document. It will C<die> if there is an
error.
=head2 C<render_string>
Takes two arguments, a string and the name of an output format. Returns
a string containing the rendered document. It will C<die> if there is an
error.
=head1 AUTHOR
Hinrik Örn Sigurðsson, L<hinrik.sig@gmail.com>
View
@@ -13,7 +13,7 @@ sub new {
return bless \%self, $package;
}
sub render {
sub render_file {
my ($self, $file, $format) = @_;
if ($format !~ /^(?:ansi|text|xhtml)$/) {
@@ -28,6 +28,15 @@ sub render {
->$method();
}
sub render_string {
my ($self, $string, $format) = @_;
open my $handle, '<', \$string or die "Can't open input filehandle: $!";
my $result = $self->render_file($handle, $format);
close $handle;
return $result;
}
1;
=encoding UTF-8
@@ -42,12 +51,18 @@ App::Grok::Pod6 - A Pod 6 backend for grok
This is the constructor. It currently takes no arguments.
=head2 C<render>
=head2 C<render_file>
Takes two arguments, a filename and the name of an output format. Returns
a string containing the rendered document. It will C<die> if there is an
error.
=head2 C<render_string>
Takes two arguments, a string and the name of an output format. Returns
a string containing the rendered document. It will C<die> if there is an
error.
=head1 AUTHOR
Hinrik Örn Sigurðsson, L<hinrik.sig@gmail.com>
View
@@ -31,8 +31,9 @@ B<grok> <options> <target>
If you don't supply the -F or -i options, you need to supply a target.
The following targets are recognized:
* A synopsis (e.g. 's02', 's02-bits', 's32-rules')
* A synopsis name (e.g. 's02', 's02-bits', 's32-rules')
* A path to a file containing Pod
* A function name from Synopsis 29
=head1 DESCRIPTION
View
@@ -7,8 +7,8 @@ use App::Grok::Pod5;
my $pod = catfile('t_source', 'basic5.pod');
ok(my $render = App::Grok::Pod5->new(), 'Constructed renderer object');
my $text = $render->render($pod, 'text');
my $ansi = $render->render($pod, 'ansi');
my $text = $render->render_file($pod, 'text');
my $ansi = $render->render_file($pod, 'ansi');
ok(length $text, 'Got text output');
ok(length $ansi, 'Got colored text output');
View
@@ -7,8 +7,8 @@ use App::Grok::Pod6;
my $pod = catfile('t_source', 'basic.pod');
ok(my $render = App::Grok::Pod6->new(), 'Constructed renderer object');
my $text = $render->render($pod, 'text');
my $ansi = $render->render($pod, 'ansi');
my $text = $render->render_file($pod, 'text');
my $ansi = $render->render_file($pod, 'ansi');
ok(length $text, 'Got text output');
ok(length $ansi, 'Got colored text output');
View
@@ -1,12 +1,13 @@
use strict;
use warnings;
use File::Spec::Functions 'catfile';
use Test::More tests => 2;
use Test::More tests => 4;
my $script = catfile('script', 'grok');
my $index_short = qx/$^X $script -i/;
my $index_long = qx/$^X $script --index/;
like($index_short, qr/^S02/m, 'Got index (-i)');
like($index_long, qr/^S02/m, 'Got index (--index)');
like($index_short, qr/^S02/m, 'Found synopsis in index (-i)');
like($index_long, qr/^S02/m, 'Found synopsis in (--index)');
like($index_short, qr/^say\b/m, 'Found function in index (-i)');
like($index_long, qr/^sleep\b/m, 'Found function in (--index)');
View
@@ -0,0 +1,13 @@
use strict;
use warnings;
use File::Spec::Functions 'catfile';
use Test::More tests => 2;
$ENV{GROK_SHAREDIR} = 'share';
my $grok = catfile('script', 'grok');
my $fork = qx/$^X $grok fork/;
my $kill = qx/$^X $grok kill/;
like($fork, qr/process/, "Got fork()");
like($kill, qr/TERM/, "Got kill()");

0 comments on commit 5175433

Please sign in to comment.