Skip to content

Commit

Permalink
Move all resource backends to App::Grok::Resource::*
Browse files Browse the repository at this point in the history
  • Loading branch information
@hinrik
hinrik committed Jul 24, 2009
1 parent 625d117 commit b007a4b
Show file tree
Hide file tree
Showing 10 changed files with 602 additions and 220 deletions.
1 change: 1 addition & 0 deletions Changes
View file
@@ -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
Expand Down
5 changes: 5 additions & 0 deletions MANIFEST
View file
Expand Up @@ -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
Expand Down
272 changes: 57 additions & 215 deletions lib/App/Grok.pm
View file
Expand Up @@ -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<dist_dir>;
use File::Spec::Functions qw<catdir catfile splitpath>;
use File::Temp qw<tempfile>;
use IO::Interactive qw<is_interactive>;
use Getopt::Long qw<:config bundling>;
Expand All @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -88,216 +98,71 @@ 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<Apocalypse Exegesis Magazine Synopsis>;

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 {
return 'App::Grok::Parser::Pod6';
}
}

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<Apocalypse Exegesis Magazine Synopsis>;

# 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 {
Expand Down Expand Up @@ -356,39 +221,16 @@ 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 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>
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_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.
=head2 C<find_perl6_doc>
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<Note:> this method is called by L<C<find_target>|/find_target>.
=head2 C<find_module_or_program>
=head2 C<locate_target>
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.
Takes a target name as an argument. Returns the path to the target, or nothing
if the target is not recognized.
=head2 C<render_target>
Expand Down

0 comments on commit b007a4b

Please sign in to comment.