Subversion Repositories DevTools

########################################################################

# Copyright (C) 2009 ERG Limited, All rights reserved

#

# Module name   : jats_help.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Utility to drive the JATS Help System

#

# Usage:

#

#......................................................................#

require 5.008_002;

use strict;

use warnings;

use Pod::Usage;

use Pod::Find qw(contains_pod);

use Getopt::Long;

use JatsError;

#-------------------------------------------------------------------------------

#   Global variables

#

my $VERSION = "1.0.0";                      # Update this

#

#   Options

#

my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug

my $opt_verbose = $ENV{'opt_verbose'};      # Allow global verbose

my $opt_help = 0;

my $opt_all = 0;

#

#   Hash of substitute/hide items

#   Hide with undef value

#

my %subst = (

    'jmake'                 => 'make',

    'buildlib'              => 'build',

    #

    #   Don't show the user these programs

    #   Many are internal programs and don't have POD

    #

    'cloc-1.00'             => undef,

    'common'                => undef,

    'makelib'               => undef,

    'installpkg'            => undef,

);

#

#   A list of paths to search

#

my @etool_path = ( "$ENV{'GBE_TOOLS'}",

#                   "$ENV{'GBE_TOOLS'}/DEPLOY",

#                   "$ENV{'GBE_TOOLS'}/LOCAL",

                   "$ENV{'GBE_TOOLS'}/POD"

                    );

my @all_path = (   "$ENV{'GBE_TOOLS'}/DEPLOY",

                   "$ENV{'GBE_TOOLS'}/LOCAL",

                    );

#-------------------------------------------------------------------------------

# Function        : Mainline Entry Point

#

# Description     :

#

# Inputs          :

#

my $result = GetOptions (

                "help|h:+"      => \$opt_help,

                "manual:3"      => \$opt_help,

                "verbose+"      => \$opt_verbose,           # flag, multiple use allowed

                "all:+"         => \$opt_all,

                #

                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!

                #

                );

#

#   Configure the error reporting process now that we have the user options

#

ErrorConfig( 'name'    =>'help',

             'verbose' => $opt_verbose,

            );

#

#   Extend the search path if required

#

push @etool_path, @all_path if ( $opt_all );

#-------------------------------------------------------------------------------

#

#   If the user has not provided any arguments, then display some simple

#   help and a list of possible commands

#

if ( $#ARGV < 0 )

{

    pod2usage(-verbose => $opt_help,

              -message => "Version: $VERSION",

              -exitval => 'noexit'

              );

    unless( $opt_help )

    {

        display_help_items("",   'Items',   '*.pod');

        display_help_items("\n", 'Commands','*.pl');

    }

    exit 0;

}

#-------------------------------------------------------------------------------

#   Take the user argument as help topic and attempt to locate it it as:

#       JATS etool          - Exists as a tool

#       JATS help item      - Exists in a POD directory

#

#

#   Allow the user item to be substituted

#   Some commands had bad names

#

#   First, invert the %subst hash and delete the hidden entries

#

my %lookup;

while (my ($k,$v) = each(%subst)) {

    $lookup{$v} = $k if ( defined $v );

}

my $uitem =$ARGV[0];

$uitem = $lookup{$uitem}

    if ( $lookup{$uitem} );

#

#   Scan for all possible items

#

my @item_paths;

foreach my $path ( @etool_path )

{

    Verbose2 ("Scanning: $path");

    foreach my $prefix ( 'jats_', '' )

    {

        foreach my $suffix ( '.pl', '.pod', '' )

        {

            my $item = $path . '/' . $prefix . $uitem . $suffix;

            push @item_paths, $item if ( -f $item );

        }

    }

}

#

#   If no topics are found, then prod the user

#

Error ("No matching help topic found for : $uitem",

       "Use 'jats help' to provide a list of available topics"

        )unless ( @item_paths );

#

#   Process the required items

#

Verbose ( "Items", @item_paths  );

foreach my $item ( @item_paths )

{

    pod2usage(-input   => $item,

              -verbose => $opt_help,

              -exitval => 'noexit' );

}

exit (0);

#-------------------------------------------------------------------------------

# Function        : display_help_items

#

# Description     : Create and display a list of help items

#                   This will be created based on the search path

#

#                   Append a (*) to programs that don't have any POD

#                   Should serve as a hint to add some helpful help

#

# Inputs          : prefix

#                   header

#                   List of files to match

#

# Returns         : Does not return

#

sub display_help_items

{

    my ($prefix, $header, @ext_list) = @_;

    #

    #   Display a list of commands

    #

    my %list;

    foreach my $path ( @etool_path )

    {

        Verbose2 ("Scanning: $path");

        foreach my $ext ( @ext_list )

        {

            foreach my $file (  glob( "$path/$ext") )

            {

                my $pod = contains_pod ($file, 0 );

                unless ( $opt_verbose )

                {

                    $file =~ s~.*/~~;

                    $file =~ s~\.pl$~~;

                    $file =~ s~\.pod$~~;

                    $file =~ s~^jats_~~;

                    if ( exists $subst{$file} )

                    {

                        $file = $subst{$file};

                        next unless ( $file );

                    }

                }

                $file .= ' *' unless ( $pod );

                $list{$file} = 1;

            }

        }

    }

    my $count = 0;

    my $limit = $opt_verbose ? 1 : 3;

    print "${prefix}Available Help $header\n", '-' x 80;

    foreach ( sort keys %list )

    {

        print "\n  " if ( !( $count++ % $limit) );

        printf "%-26s", $_;

    }

    print "\n";

#    print "\n",'-' x 80, "\n";

}

#-------------------------------------------------------------------------------

#   Documentation

#

=pod

=head1 NAME

help - Display help from the various JATS utilities

=head1 SYNOPSIS

 Usage: jats help [opts] topic

 Where opts:

    -h, -h=[n], -man=[n]    - Help messages with increasing verbosity

    -verbose[=n]            - Verbose operation

    -all                    - Also search to internal directories

 Where topic is one of:

    A help item             - Documentation on a specific aspect of JATS

    A JATS command          - Commands with built in help

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-verbose[=n]>

This option will increase the level of verbosity of the JATS command.

If an argument is provided, then it will be used to set the level, otherwise the

existing level will be incremented. This option may be specified multiple times.

=item B<-all>

This option will extend the directories that the help utility will scan for

programs and documentation files to include several internal directories.

=back

=head1 DESCRIPTION

This program will display help information from the various JATS utility

programs.

Without any options the program will display a list of available commands with

built-in help and specialised items.

Commands may be flagged with with a '*' to indicate that the command does not

have any built-in help. This serves as an indication that the command needs to

be documented.

=cut