rev 1451 - in trunk/siesta: . bin

[prev] [thread] [next] [lurker] [Date index for 2003/10/21]

From: simon
Subject: rev 1451 - in trunk/siesta: . bin
Date: 09:02 on 21 Oct 2003
Author: simon
Date: 2003-10-21 09:02:17 +0100 (Tue, 21 Oct 2003)
New Revision: 1451

Modified:
   trunk/siesta/Build.PL
   trunk/siesta/bin/nacho
Log:
Add in a help command to nacho


Modified: trunk/siesta/Build.PL
===================================================================
--- trunk/siesta/Build.PL	2003-10-17 16:36:27 UTC (rev 1450)
+++ trunk/siesta/Build.PL	2003-10-21 08:02:17 UTC (rev 1451)
@@ -17,6 +17,7 @@
         'Email::Folder' => 0,
         'Email::Simple' => '1.4',
         'Email::LocalDelivery' => '0.05',
+        'FindBin' => 0,
         'File::Path' => 0,
         'File::Basename' => 0,
         'File::Find::Rule' => 0,
@@ -25,6 +26,7 @@
         # Module::Build 0.18 is the first release with
         # working scripts shebang rewriting
         'Module::Build' => '0.18',
+        'Module::Pluggable' => '0.8',
         'Python::Serialise::Marshal' => 0,
         'Storable' => 0,
         'String::Random' => 0,

Modified: trunk/siesta/bin/nacho
===================================================================
--- trunk/siesta/bin/nacho	2003-10-17 16:36:27 UTC (rev 1450)
+++ trunk/siesta/bin/nacho	2003-10-21 08:02:17 UTC (rev 1451)
@@ -1,6 +1,8 @@
 #!/usr/local/bin/perl -w
 # $Id$
 use strict;
+use Carp;
+use FindBin;
 use File::Path qw(mkpath);
 use File::Basename;
 use Data::Dumper;
@@ -531,7 +533,7 @@
     }
 
     my %plugins = map { $_->name => $_ } @plugins;
-
+    
     my $plugin  = $plugins{$plugin_id}
       or die "That plugin is not used in the list '$list_id'\n";
 
@@ -751,6 +753,35 @@
 };
 
 
+=head2 help [command]
+
+Print out some general help or, if a command is given, print out help for that.
+
+=cut
+
+$commands{'help'} = sub {
+    # just print out the list of commands
+    unless (@_) {
+        print usage(),"\n";
+        return;
+    }
+
+    my $command = shift;
+    my $pod     = Nacho::PodExtract->new() || die "No Nacho::PodExtract\n";
+    my $self    = -r $0 ? $0 : -r $FindBin::Bin . "/" . $0 ? -r $FindBin::Bin
+                  . "/" . $0 :
+                  croak "Couldn't automatically parse your POD - $0 not readable!";
+
+    $pod->parse_from_file($self, '/dev/null');
+    die "No such command '$command'\n" unless defined $pod->{funcs}{$command};
+
+    my $help = "\n".$pod->{funcs}{$command}{fullname}."-\n". $pod->{funcs}{$command}{longhelp}."\n";  
+    $help =~ s!(C|I|B)<([^>]+)>!$2!g;
+
+    print $help;
+};
+
+
 sub usage {
     my $name = basename $0;
 
@@ -772,7 +803,6 @@
 $cmd->(@ARGV);
 
 exit 0;
-__END__
 
 =head1 SEE ALSO
 
@@ -790,3 +820,34 @@
 
 =cut
 
+package Nacho::PodExtract;
+use Pod::Parser;
+use base 'Pod::Parser';
+
+sub command {
+    my $self = shift;
+    my ($command, $text, $line_num) = @_;
+    if ($command =~ /^head2/) {
+        chomp($text);
+        my ($name) = ($text =~ /^([^\s]+)/);
+        $self->{copying} = 1;
+        $self->{latest}  = $name;
+        $self->{funcs}{$name}{fullname} = $text;
+
+    }
+}
+
+sub verbatim {
+    my ($self, $paragraph, $line_num) = @_;
+    $self->{funcs}{ $self->{latest} }{longhelp} .= $paragraph
+      if $self->{copying};
+}
+
+sub textblock {
+    my ($self, $paragraph, $line_num) = @_;
+    $self->{funcs}{ $self->{latest} }{longhelp} .=
+      $self->interpolate($paragraph, $line_num)
+      if $self->{copying};
+}
+
+1;

Generated at 13:57 on 01 Jul 2004 by mariachi 0.52