[Bps-public-commit] r15823 - in App-CLI/trunk: lib/App lib/App/CLI/Command

[clkao at bestpractical.com]

Author: clkao
Date: Mon Sep  8 07:13:33 2008
New Revision: 15823

Added:
   App-CLI/trunk/lib/App/CLI/Command/
   App-CLI/trunk/lib/App/CLI/Command/Help.pm
Modified:
   App-CLI/trunk/   (props changed)
   App-CLI/trunk/MANIFEST
   App-CLI/trunk/lib/App/CLI.pm

Log:
 r334 at mtl:  clkao | 2005-12-27 09:04:46 +0800
 forgot to bundle command::help.


Modified: App-CLI/trunk/MANIFEST
==============================================================================
--- App-CLI/trunk/MANIFEST	(original)
+++ App-CLI/trunk/MANIFEST	Mon Sep  8 07:13:33 2008
@@ -1,4 +1,5 @@
 inc/ExtUtils/AutoInstall.pm
+inc/Module/AutoInstall.pm
 inc/Module/Install.pm
 inc/Module/Install/AutoInstall.pm
 inc/Module/Install/Base.pm
@@ -11,8 +12,10 @@
 inc/Module/Install/WriteAll.pm
 lib/App/CLI.pm
 lib/App/CLI/Command.pm
+lib/App/CLI/Command/Help.pm
 Makefile.PL
 MANIFEST			This list of files
+Changes
 META.yml
 SIGNATURE
 t/1basic.t

Modified: App-CLI/trunk/lib/App/CLI.pm
==============================================================================
--- App-CLI/trunk/lib/App/CLI.pm	(original)
+++ App-CLI/trunk/lib/App/CLI.pm	Mon Sep  8 07:13:33 2008
@@ -1,5 +1,5 @@
 package App::CLI;
-our $VERSION = 0.02;
+our $VERSION = 0.03;
 use strict;
 use warnings;
 

Added: App-CLI/trunk/lib/App/CLI/Command/Help.pm
==============================================================================
--- (empty file)
+++ App-CLI/trunk/lib/App/CLI/Command/Help.pm	Mon Sep  8 07:13:33 2008
@@ -0,0 +1,73 @@
+package App::CLI::Command::Help;
+use strict;
+use warnings;
+use base qw/App::CLI::Command/;
+use File::Find qw(find);
+use Locale::Maketext::Simple;
+
+sub run {
+    my $self = shift;
+    my @topics = @_;
+
+    push @topics, 'commands' unless (@topics);
+
+    foreach my $topic (@topics) {
+        if ($topic eq 'commands') {
+            $self->brief_usage ($_) for $self->app->files;
+        }
+        elsif (my $cmd = eval { $self->app->get_cmd ($topic) }) {
+            $cmd->usage(1);
+        }
+        elsif (my $file = $self->_find_topic($topic)) {
+            open my $fh, '<:utf8', $file or die $!;
+            my $parser = Pod::Simple::Text->new;
+            my $buf;
+            $parser->output_string(\$buf);
+            $parser->parse_file($fh);
+
+            $buf =~ s/^NAME\s+(.*?)::Help::\S+ - (.+)\s+DESCRIPTION/    $1:/;
+            print $self->loc_text($buf);
+        }
+        else {
+            die loc("Cannot find help topic '%1'.\n", $topic);
+        }
+    }
+    return;
+}
+
+sub help_base {
+    my $self = shift;
+    return ref($self->app)."::Help";
+}
+
+my ($inc, @prefix);
+sub _find_topic {
+    my ($self, $topic) = @_;
+
+    if (!$inc) {
+        my $pkg = __PACKAGE__;
+        $pkg =~ s{::}{/};
+        $inc = substr( __FILE__, 0, -length("$pkg.pm") );
+
+        my $base = $self->help_base;
+        @prefix = (loc($base));
+        $prefix[0] =~ s{::}{/}g;
+        $base =~ s{::}{/}g;
+        push @prefix, $base if $prefix[0] ne $base;
+    }
+
+    foreach my $dir ($inc, @INC) {
+        foreach my $prefix (@prefix) {
+            foreach my $basename (ucfirst(lc($topic)), uc($topic)) {
+                foreach my $ext ('pod', 'pm') {
+                    my $file = "$dir/$prefix/$basename.$ext";
+                    return $file if -f $file;
+                }
+            }
+        }
+    }
+
+    return;
+}
+
+1;