Permalink
Browse files

Add -U/--update to download latest versions of documents from the web

  • Loading branch information...
1 parent f16ad94 commit a99c023f829e320caf354815f657d58d8875888c @hinrik committed Jun 16, 2010
View
@@ -1,3 +1,6 @@
+0.21
+ - Add -U/--update to download latest versions of documents from the web
+
0.20 Tue Jun 15 14:02:57 GMT 2010
- Fixed an error in a regex when matching Synopses et al
- Added (simplified) parsing of some u4x terms
View
@@ -1,11 +1,12 @@
script/grok
lib/App/Grok.pm
+lib/App/Grok/Common.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/Tablet.pm
lib/App/Grok/Resource/u4x.pm
p6/grok
Makefile.PL
@@ -28,7 +29,7 @@ t/03_opts/07_locate.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/04_targets/04_tablet.t
t/04_targets/05_failure.t
t/04_targets/06_man_page.t
t_source/basic.pod
View
@@ -20,14 +20,17 @@ homepage ('http://svn.pugscode.org/pugs/docs/u4x/README');
githubmeta ();
requires ('Getopt::Long' => '2.33');
requires ('IO::Interactive' => '0');
+requires ('File::HomeDir' => '0');
requires ('File::ShareDir' => '0');
requires ('File::Temp' => '0');
+requires ('LWP::UserAgent' => '0');
requires ('Perl6::Doc' => '0.44');
requires ('Perl6::Perldoc' => '0.0.5');
requires ('Perl6::Perldoc::To::Ansi' => '0.07');
requires ('Pod::Text::Ansi' => '0.04');
requires ('Pod::Xhtml' => '0');
requires ('Pod::Parser' => '1.36');
+recommends ('Term::ProgressBar' => '0');
recommends ('Win32::Console::ANSI' => '0') if $^O eq 'Win32';
test_requires ('Test::More' => '0');
test_requires ('Test::Script' => '0');
View
@@ -5,10 +5,11 @@ 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::Tablet qw<:ALL>;
use App::Grok::Resource::u4x qw<:ALL>;
use Config qw<%Config>;
use File::Temp qw<tempfile>;
+use File::Spec::Functions qw<catdir>;
use IO::Interactive qw<is_interactive>;
use Getopt::Long qw<:config bundling>;
use List::Util qw<first>;
@@ -40,7 +41,12 @@ sub run {
$self->_get_options();
- if ($opt{index}) {
+ if ($opt{update}) {
+ spec_update();
+ tablet_update();
+ return;
+ }
+ elsif ($opt{index}) {
my @index = $self->target_index();
print "$_\n" for @index;
return;
@@ -87,10 +93,11 @@ sub _get_options {
'o|output=s' => \($opt{output} = $GOT_ANSI ? 'ansi' : 'text'),
'T|no-pager' => \$opt{no_pager},
'u|unformatted' => sub { $opt{output} = 'pod' },
+ 'U|update' => \$opt{update},
'V|version' => sub { print "grok $VERSION\n"; exit },
) or pod2usage();
- if (!$opt{index} && !defined $opt{file} && !@ARGV) {
+ if (!$opt{update} && !$opt{index} && !defined $opt{file} && !@ARGV) {
warn "Too few arguments\n";
pod2usage();
}
@@ -101,7 +108,7 @@ sub _get_options {
sub target_index {
my ($self) = @_;
my %index;
- @index{table_index()} = 1;
+ @index{tablet_index()} = 1;
@index{spec_index()} = 1;
@index{func_index()} = 1;
@index{u4x_index()} = 1;
@@ -114,7 +121,7 @@ sub locate_target {
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 = tablet_locate($target) if !defined $found;
$found = file_locate($target) if !defined $found;
return $found if defined $found;
@@ -143,7 +150,7 @@ sub render_target {
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 = tablet_fetch($target) if !defined $found;
$found = file_fetch($target) if !defined $found;
die "Target '$target' not recognized\n" if !defined $found;
View
@@ -0,0 +1,120 @@
+package App::Grok::Common;
+
+use strict;
+use warnings;
+use File::HomeDir qw<my_data>;
+use File::Spec::Functions qw<catdir>;
+
+use base qw(Exporter);
+our @EXPORT_OK = qw(download data_dir);
+our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] );
+
+sub data_dir {
+ my $data_dir = catdir(my_data(), '.grok');
+ if (!-d $data_dir) {
+ mkdir $data_dir or die "Can't create $data_dir: $!\n";
+ }
+
+ my $res_dir = catdir($data_dir, 'resources');
+ if (!-d $res_dir) {
+ mkdir $res_dir or die "Can't create $res_dir: $!\n";
+ }
+
+ return $data_dir;
+}
+
+sub download {
+ my ($title, $url) = @_;
+
+ require LWP::UserAgent;
+ my $ua = LWP::UserAgent->new;
+ $ua->timeout(10);
+ $ua->env_proxy;
+
+ eval 'require Term::ProgressBar';
+ if ($@) {
+ print $title, "\n";
+ my $response = $ua->get($url);
+ if ($response->is_success) {
+ return $response->decoded_content;
+ }
+ else {
+ die 'Download failed: '.$response->status_line."\n";
+ }
+ }
+
+ my $bar = Term::ProgressBar->new({
+ name => $title,
+ count => 1024,
+ ETA => 'linear',
+ });
+
+ my $content;
+ my $output = 0;
+ my $target_is_set = 0;
+ my $next_so_far = 0;
+ $ua->get(
+ $url,
+ ":content_cb" => sub {
+ my ($chunk, $response, $proto) = @_;
+
+ if (!$target_is_set) {
+ if (my $cl = $response->content_length) {
+ $bar->target($cl);
+ $target_is_set = 1;
+ }
+ else {
+ $bar->target($output + 2 * length $chunk);
+ }
+ }
+
+ $output += length $chunk;
+ $content .= $chunk;
+
+ if ($output >= $next_so_far) {
+ $next_so_far = $bar->update($output);
+ }
+
+ #$bar->target($output);
+ #$bar->update($output);
+ },
+ );
+
+ return $content;
+}
+
+1;
+
+=head1 NAME
+
+App::Grok::Common - Common functions used in grok
+
+=head1 SYNOPSIS
+
+ use strict;
+ use warnings;
+ use App::Grok::Common qw<:ALL>;
+
+ # download a file, with a progress bar
+ my $url = 'http://foo.bar/baz';
+ my $content = download('My file', $url);
+
+=head1 DESCRIPTION
+
+This module provides common utility functions used in App::Grok.
+
+=head1 FUNCTIONS
+
+=head2 C<download>
+
+Downloads a file from the web and returns the contents. Prints a progress bar
+(if L<Term::ProgressBar|Term::ProgressBar> is installed) as while doing so.
+It takes two arguments, a title string and the url. Returns the downloaded
+content.
+
+=head2 C<data_dir>
+
+Creates (if necessary) and then returns the name of the directory where grok
+stores its data (e.g. F<~/.grok>).
+
+=cut
@@ -57,7 +57,7 @@ App::Grok::Resource::File - Standard file resource for grok
This resource finds arbitrary documentation on the filesystem.
-=head1 METHODS
+=head1 FUNCTIONS
=head2 C<file_index>
@@ -157,7 +157,7 @@ App::Grok::Resource::Functions - S29/S32 functions resource for grok
This resource reads Synopses 29 and 32, and allows you to look up the
functions therein.
-=head1 METHODS
+=head1 FUNCTIONS
=head2 C<func_index>
@@ -2,12 +2,13 @@ package App::Grok::Resource::Spec;
use strict;
use warnings;
+use App::Grok::Common qw<data_dir download>;
use File::ShareDir qw<dist_dir>;
-use File::Spec::Functions qw<catdir splitpath>;
+use File::Spec::Functions qw<catdir catfile splitpath>;
our $VERSION = '0.20';
use base qw(Exporter);
-our @EXPORT_OK = qw(spec_index spec_fetch spec_locate);
+our @EXPORT_OK = qw(spec_index spec_fetch spec_locate spec_update);
our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] );
my %index;
@@ -16,6 +17,36 @@ my %docs = map {
substr($_, 0, 1) => catdir($dist_dir, $_)
} qw<Apocalypse Exegesis Magazine Synopsis>;
+sub spec_update {
+ my $res_dir = catdir(data_dir(), 'resources', 'spec');
+ if (!-d $res_dir) {
+ mkdir $res_dir or die "Can't create $res_dir: $!\n";
+
+ }
+ my $s32_dir = catdir($res_dir, 'S32-setting-library');
+ if (!-d $s32_dir) {
+ mkdir $s32_dir or die "Can't create $s32_dir: $!\n";
+ }
+
+ print "Downloading specs...\n";
+ my @specs = map { chomp; $_ } <DATA>;
+
+ my $i = 0;
+ for my $spec_url (@specs) {
+ $i++;
+ my $s32 = $spec_url =~ /S32/;
+ my ($filename) = $spec_url =~ m{(?<=/)([^/]+)$};
+ my $title = "($i/".scalar @specs.") ".($s32?'S32-setting-library/': '').$filename;
+ my $content = download($title, $spec_url);
+ my $file = catfile(($s32 ? $s32_dir : $res_dir), $filename);
+ open my $fh, '>:encoding(utf8)', $file or die "Can't open $file: $!\n";
+ print $fh $content;
+ close $fh;
+ }
+
+ return;
+}
+
sub spec_fetch {
my ($topic) = @_;
_build_index() if !%index;
@@ -103,7 +134,12 @@ distributed with L<Perl6::Doc>.
It also includes user documentation like F<perlintro> and F<perlsyn>.
-=head1 METHODS
+=head1 FUNCTIONS
+
+=head2 C<spec_update>
+
+Takes no arguments. Downloads the latest specifications (Synopses) into
+grok's data dir.
=head2 C<spec_index>
@@ -122,3 +158,37 @@ Takes the same argument as L<C<spec_fetch>|/spec_fetch>. Returns the filename
corresponding to the given document.
=cut
+__DATA__
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S01-overview.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S02-bits.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S03-operators.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S04-control.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S05-regex.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S06-routines.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S07-iterators.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S08-capture.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S09-data.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S10-packages.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S11-modules.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S12-objects.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S13-overloading.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S14-roles-and-parametric-types.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S16-io.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S17-concurrency.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S19-commandline.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S21-calling-foreign-code.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S22-package-format.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S26-documentation.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S28-special-names.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S29-functions.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S31-pragmatic-modules.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Abstraction.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Basics.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Callable.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Containers.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Exception.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/IO.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Numeric.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Rules.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Str.pod
+http://svn.pugscode.org/pugs/docs/Perl6/Spec/S32-setting-library/Temporal.pod
Oops, something went wrong. Retry.

0 comments on commit a99c023

Please sign in to comment.