[Bps-public-commit] r15822 - in App-CLI/trunk: . lib/App

[clkao at bestpractical.com]

Author: clkao
Date: Mon Sep  8 07:13:00 2008
New Revision: 15822

Added:
   App-CLI/trunk/Changes
Modified:
   App-CLI/trunk/   (props changed)
   App-CLI/trunk/Makefile.PL
   App-CLI/trunk/lib/App/CLI.pm
   App-CLI/trunk/lib/App/CLI/Command.pm

Log:
 r333 at mtl:  clkao | 2005-12-25 16:09:33 +0800
 * Factored out Help system from SVK
 * Factored out more command base stuff from SVK
 
 Submitted by: Alex Vandiver
 
 
 


Added: App-CLI/trunk/Changes
==============================================================================
--- (empty file)
+++ App-CLI/trunk/Changes	Mon Sep  8 07:13:00 2008
@@ -0,0 +1,5 @@
+* 0.02 - 25 Dec 2005
+
+  * Factored out Help system from SVK
+  * Factored out more command base stuff from SVK
+  (Thanks to Alex Vandiver)

Modified: App-CLI/trunk/Makefile.PL
==============================================================================
--- App-CLI/trunk/Makefile.PL	(original)
+++ App-CLI/trunk/Makefile.PL	Mon Sep  8 07:13:00 2008
@@ -9,7 +9,8 @@
 version_from	('lib/App/CLI.pm');
 
 requires(
-        'Getopt::Long'          => '2.34',
+    'Locale::Maketext::Simple' => 0,
+    'Getopt::Long'             => '2.34',
 );
 
 include('ExtUtils::AutoInstall');

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:00 2008
@@ -1,5 +1,5 @@
 package App::CLI;
-our $VERSION = 0.01;
+our $VERSION = 0.02;
 use strict;
 use warnings;
 
@@ -107,7 +107,9 @@
 	warn $@ if $@ and exists $INC{$file};
 	die $class->error_cmd;
     }
-    $pkg->new (@arg);
+    $cmd = $pkg->new (@arg);
+    $cmd->app ($class);
+    return $cmd;
 }
 
 sub _opt_map {
@@ -118,10 +120,17 @@
 sub commands {
     my $class = shift;
     $class =~ s{::}{/}g;
-    my @cmd;
     my $dir = $INC{$class.'.pm'};
     $dir =~ s/\.pm$//;
-    return sort map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } glob("$dir/*.pm");
+    return sort map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files;
+}
+
+sub files {
+    my $class = shift;
+    $class =~ s{::}{/}g;
+    my $dir = $INC{$class.'.pm'};
+    $dir =~ s/\.pm$//;
+    return sort glob("$dir/*.pm");
 }
 
 =head1 TODO

Modified: App-CLI/trunk/lib/App/CLI/Command.pm
==============================================================================
--- App-CLI/trunk/lib/App/CLI/Command.pm	(original)
+++ App-CLI/trunk/lib/App/CLI/Command.pm	Mon Sep  8 07:13:00 2008
@@ -1,6 +1,8 @@
 package App::CLI::Command;
 use strict;
 use warnings;
+use Pod::Simple::Text;
+use Locale::Maketext::Simple;
 
 =head1 NAME
 
@@ -64,6 +66,106 @@
     }
 }
 
+sub app {
+    my $self = shift;
+    die Carp::longmess "not a ref" unless ref $self;
+    $self->{app} = shift if @_;
+    return ref ($self->{app}) || $self->{app};
+}
+
+=head3 brief_usage ($file)
+
+Display an one-line brief usage of the command object.  Optionally, a file
+could be given to extract the usage from the POD.
+
+=cut
+
+sub brief_usage {
+    my ($self, $file) = @_;
+    open my ($podfh), '<', ($file || $self->filename) or return;
+    local $/=undef;
+    my $buf = <$podfh>;
+    my $base = $self->app;
+    if($buf =~ /^=head1\s+NAME\s*\Q$base\E::(\w+ - .+)$/m) {
+        print "   ",loc(lc($1)),"\n";
+    } else {
+        my $cmd = $file ||$self->filename;
+        $cmd =~ s/^(?:.*)\/(.*?).pm$/$1/;
+        print "   ", lc($cmd), " - ",loc("undocumented")."\n";
+    }
+    close $podfh;
+}
+
+=head3 usage ($want_detail)
+
+Display usage.  If C<$want_detail> is true, the C<DESCRIPTION>
+section is displayed as well.
+
+=cut
+
+sub usage {
+    my ($self, $want_detail) = @_;
+    my $fname = $self->filename;
+    my($cmd) = $fname =~ m{\W(\w+)\.pm$};
+    my $parser = Pod::Simple::Text->new;
+    my $buf;
+    $parser->output_string(\$buf);
+    $parser->parse_file($fname);
+
+    my $base = $self->app;
+    $buf =~ s/\Q$base\E::(\w+)/\l$1/g;
+    $buf =~ s/^AUTHORS.*//sm;
+    $buf =~ s/^DESCRIPTION.*//sm unless $want_detail;
+    print $self->loc_text($buf);
+}
+
+=head3 loc_text $text
+
+Localizes the body of (formatted) text in $text, and returns the
+localized version.
+
+=cut
+
+sub loc_text {
+    my $self = shift;
+    my $buf = shift;
+
+    my $out = "";
+    foreach my $line (split(/\n\n+/, $buf, -1)) {
+        if (my @lines = $line =~ /^( {4}\s+.+\s*)$/mg) {
+            foreach my $chunk (@lines) {
+                $chunk =~ /^(\s*)(.+?)( *)(: .+?)?(\s*)$/ or next;
+                my $spaces = $3;
+                my $loc = $1 . loc($2 . ($4||'')) . $5;
+                $loc =~ s/: /$spaces: / if $spaces;
+                $out .= $loc . "\n";
+            }
+            $out .= "\n";
+        }
+        elsif ($line =~ /^(\s+)(\w+ - .*)$/) {
+            $out .= $1 . loc($2) . "\n\n";
+        }
+        elsif (length $line) {
+            $out .= loc($line) . "\n\n";
+        }
+    }
+    return $out;
+}
+
+=head3 filename
+
+Return the filename for the command module.
+
+=cut
+
+sub filename {
+    my $self = shift;
+    my $fname = ref($self);
+    $fname =~ s{::[a-z]+}{}; # subcommand
+    $fname =~ s{::}{/}g;
+    $INC{"$fname.pm"}
+}
+
 =head1 TODO
 
 More documentation