#!/usr/bin/perl
#
# $Header: /Users/claude/fuzz/lib/Genezzo/RCS/BasicHelp.pm,v 1.12 2007/06/26 08:12:39 claude Exp claude $
#
# copyright (c) 2006, 2007 Jeffrey I Cohen, all rights reserved, worldwide
#
#
package Genezzo::BasicHelp;
use Genezzo::Util;
use Pod::Text;
use strict;
use warnings;
use warnings::register;
use Carp;
our $VERSION;
BEGIN {
$VERSION = do { my @r = (q$Revision: 1.12 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
}
sub getpod
{
my $bigHelp;
($bigHelp = <<EOF_HELP) =~ s/^\#//gm;
#=head1 Basic_Commands
#
# The Genezzo database supports a variety of interactive commands.
#
#=head2 @ : execute a command file. Syntax - @<filename>
#
#=head2 !<number>, !! : re-execute command history
#
#=head2 addfile, af : add a file to a tablespace. Type "addfile help" for more details.
#
#=head2 alter : SQL alter
#
# ALTER TABLE tablename
# ADD [CONSTRAINT constraint_name]
# PRIMARY KEY (colname [, colname ...]);
# ALTER TABLE tablename
# ADD [CONSTRAINT constraint_name]
# UNIQUE (colname [, colname ...]);
# ALTER TABLE tablename
# ADD [CONSTRAINT constraint_name]
# CHECK (conditional_expression);
#
#=head2 ci : create index. Syntax - ci <index name> <table name> <column name>.
#
#=head2 commit : flush changes to disk
#
#=head2 create : SQL Create
#
# CREATE TABLE
# tablename (column_name column_type [, column_name column_type]...)
# [TABLESPACE tsname] [AS SELECT...]
#
# CREATE TABLESPACE tsname
#
# CREATE INDEX indexname
# ON tablename (column_name [, column_name]...)
# [TABLESPACE tsname]
#
#=head2 ct : create table.
#
# Syntax -
# ct <tablename> <column name>=<column type> [<column name>=<column type>...]
# Supported types are "c" for character data and "n" for numeric.
#
#=head3 SEE ALSO: Create Table
#
#=head2 d : delete from a table. Syntax - d <table-name> <rid> [<rid>...]
#
#=head2 delete : SQL Delete
#
# DELETE FROM tablename [WHERE ...]
#
#=head2 describe, desc : describe a table
#
#=head2 drop : SQL Drop
#
# DROP TABLE tablename
#
#=head2 dt : drop table. Syntax - dt <table-name>
#
#=head2 dump : dump internal state. Type "dump help" for more details.
#
#=head2 help, help <topic> : Get general help or help on a specific topic
#
# help - general help for all topics
# help <topic> - find the matching topics and list them. Some perl
# regex is supported.
#
# The general help provides the full help for every topic. If
# "Help <topic>" is used, help lists all matching topics, followed
# by a short description for each one. If only a single
# topic matches, it prints a full (long) description. A more
# complex help syntax is also supported:
#
# help [area=<area>] [list=<topic>] [short=<topic>] [long=<topic>] [topic]
#
# Provide the specified level of detail on a topic or set of topics
# in a particular area. If unspecified, the default area
# (which you are currently viewing) is Basic_Commands. To list
# all available areas enter
# help area=
#
# For example, the command
# help area=sql_functions short=u
# provides a short description of all topics beginning with 'u' in
# the area of "sql_functions". Note that "area=" supports a regex
# match as well, but the regex must match a unique area.
#
#=head2 history, h : command history. Use shell-style "!<command-number>" to repeat.
#
# use "history -clear" to clear the history buffer.
#
#=head2 i : insert into a table.
#
# Syntax - i <tablename> <column-data> [<column-data>...]
#
#=head2 insert : SQL Insert
#
# INSERT INTO tablename VALUES (expr [, expr ...]);
# INSERT INTO tablename (colname [, colname ...])
# VALUES (expr [, expr ...]);
# INSERT INTO tablename SELECT ... FROM ...
#
#=head2 password : password authentication [unused]
#
#=head2 quit : quit the line-mode app
#
#=head2 reload : Reload all genezzo modules
#
#=head2 rem : Remark [comment]
#
#=head2 rollback : discard uncommitted changes
#
#=head2 s : select from a table.
#
# Syntax - s <table-name> *
# s <table-name> <column-name> [<column-name>...]
# Legal "pseudo-columns" are "rid", "rownum".
#
#=head2 select : SQL Select
#
# SELECT expr [[AS] column_alias] [, expr [[AS] column_alias]]
# FROM tablename [[AS] table_alias] [, tablename ...]
# [WHERE ...]
#
#
#=head2 show : License, warranty, and version information. Type "show help" for more information.
#
#=head2 shutdown : shutdown an instance. Provides read-only access to "pref1" table.
#
#=head2 spool : write output to a file. Syntax - spool <filename>
#
#=head2 startup : Loads dictionary, provides read/write access to tables.
#
#=head2 sync : flush changes to disk (*without* committing transaction like "commit")
#
#=head2 u : update a table.
#
# Syntax - u <table-name> <rid> <column-value> [<column-value>...]
#
#=head2 update : SQL Update
#
# UPDATE tablename SET colname = expr [, colname = expr ...] [WHERE ...]
EOF_HELP
my $msg = $bigHelp;
return $msg;
}
sub getpod2text
{
my $rawpod = getpod();
my $podtxt = 1; # need to initialize this for some reason...
my ($in_fh, $out_fh);
open($in_fh, '<', \$rawpod);
open($out_fh, '>', \$podtxt);
# use loose setting to get spaces after headings...
my $parser = Pod::Text->new(loose => 1);
$parser->parse_from_filehandle($in_fh,$out_fh);
return $podtxt;
}
sub pod2gnzhelp
{
my ($self, $pod) = @_;
my @biga = split(/\n/, $pod);
my $bigh = {};
if (exists($self->{bigh})
&& defined($self->{bigh}))
{
$bigh = $self->{bigh};
}
my $topic_group;
my $topic_group_name;
my $topic_group_desc;
my $topic;
my $topic_name;
my $long_desc;
my $maxline = scalar(@biga);
my $lineno = 0;
while ($lineno < $maxline)
{
my $line = $biga[$lineno];
if ($line =~ m/^=head/)
{
if ($line =~ m/^=head(1|2|3)/)
{
if (defined($long_desc) && defined($topic))
{
$topic->{long_desc} = $long_desc;
$long_desc = undef;
}
if (defined($topic_group_desc) &&
defined($topic_group))
{
$topic_group->{long_desc} = $topic_group_desc;
$topic_group_desc = undef;
}
}
if ($line =~ m/^=head(1|2)/ && defined($topic))
{
$topic_group->{entries}->{$topic_name} = $topic
if (defined($topic_group));
$topic = undef;
}
if ($line =~ m/^=head3/ && defined($topic))
{
$line =~ s/^=head3//;
my @foo = split(/:/, $line, 2);
unless (scalar(@foo) == 2)
{
print "bad header3: ", $line, "\n";
goto L_endloop;
}
my $kk = shift @foo;
$kk =~ s/^\s*//;
$kk =~ s/\s*$//;
my $vv = shift @foo;
$vv =~ s/^\s*//;
$vv =~ s/\s*$//;
$topic->{$kk} = $vv;
}
if ($line =~ m/^=head2/ && defined($topic_group))
{
$line =~ s/^=head2//;
my @foo = split(/:/, $line, 2);
unless (scalar(@foo) == 2)
{
print "bad header2: ", $line, "\n";
goto L_endloop;
}
my $kk = shift @foo;
$kk =~ s/^\s*//;
$kk =~ s/\s*$//;
$topic_name = $kk;
$topic = {};
$topic_group->{entries}->{$topic_name} = $topic;
my $vv = shift @foo;
$vv =~ s/^\s*//;
$vv =~ s/\s*$//;
$topic->{short_desc} = $vv;
}
if ($line =~ m/^=head1/)
{
$topic_group = {};
$topic_group->{entries} = {};
$line =~ s/^=head1//;
$line =~ s/^\s*//;
$line =~ s/\s*$//;
$bigh->{entries}->{$line} = $topic_group;
$topic_group_name = $line;
}
}
else
{
if (defined($long_desc) && defined($topic))
{
$long_desc .= "\n" . $line;
}
elsif (!defined($long_desc) &&
defined($topic) &&
# need to handle case of head3 after long_desc, and
# not create new long_desc if one already exists
!(exists($topic->{long_desc})))
{
$long_desc = "";
$long_desc .= $line;
}
elsif (defined($topic_group_desc) &&
defined($topic_group))
{
$topic_group_desc .= "\n" . $line;
}
elsif (!defined($topic_group_desc) &&
defined($topic_group) &&
!(exists($topic_group->{long_desc})))
{
$topic_group_desc = "";
$topic_group_desc .= $line;
}
}
L_endloop:
$lineno++;
} # end while
if (defined($long_desc) && defined($topic))
{
$topic->{long_desc} = $long_desc;
$long_desc = undef;
}
if (defined($topic_group_desc) &&
defined($topic_group))
{
$topic_group->{long_desc} = $topic_group_desc;
$topic_group_desc = undef;
}
if (defined($topic))
{
$topic_group->{entries}->{$topic_name} = $topic
if (defined($topic_group));
$topic = undef;
}
return $bigh;
}
# build the initial help hash based upon the BasicHelp pod
sub _basic_help_hash
{
my $self = shift;
my $bigpod = getpod();
return pod2gnzhelp($self, $bigpod);
}
sub _init
{
my $self = shift;
my %nargs = @_;
$self->{bigh} = _basic_help_hash($self);
return 1;
}
sub new
{
my $invocant = shift;
my $class = ref($invocant) || $invocant ;
my $self = { };
my %args = (@_);
if ((exists($args{GZERR}))
&& (defined($args{GZERR}))
&& (length($args{GZERR})))
{
$self->{GZERR} = $args{GZERR};
}
return undef
unless (_init($self, %args));
return bless $self, $class;
} # end new
sub search_topic
{
my $self = shift;
my %optional = (
# topic_pattern => '',
option => 'LIST',
topic_group => "Basic_Commands"
);
my %required = (
# topic_group => "no topic group !"
);
my %args = (%optional,
@_);
# return 0
# unless (Validate(\%args, \%required));
my $topic_group = $args{topic_group};
my $format_option = $args{option};
my $topic_pattern;
if (exists($args{topic_pattern}) && defined($args{topic_pattern}))
{
$topic_pattern = $args{topic_pattern};
if ($topic_pattern =~ m/^\*/)
{
$topic_pattern =~ s/^\*/\.\*/;
}
my @baz;
my $foo = "foo";
my $test_pattern = "\@baz = (\$foo =~ m/$topic_pattern/);";
# avoid blowing up
eval $test_pattern;
if ($@)
{
my $outi = "invalid pattern \"$topic_pattern\": $@\n";
return $outi;
}
}
{
if ($topic_group =~ m/^\*/)
{
$topic_group =~ s/^\*/\.\*/;
}
my @baz;
my $foo = "foo";
my $test_pattern = "\@baz = (\$foo =~ m/$topic_group/);";
# avoid blowing up
eval $test_pattern;
if ($@)
{
my $outi = "invalid group specification \"$topic_group\" : $@\n";
return $outi;
}
}
my $bigh = $self->{bigh};
my $top_h = $bigh;
my @all_topic_groups;
# case-insensitive match for area/group name
for my $tg (sort(keys(%{$top_h->{entries}})))
{
if ($tg =~ m/^$topic_group/i)
{
push @all_topic_groups, $tg;
}
}
unless (scalar(@all_topic_groups))
{
my $outi = "no matches for $topic_group\n";
return $outi;
}
if (scalar(@all_topic_groups) > 1)
{
my $outi = "multiple matches: \n " .
join("\n ", @all_topic_groups) . "\n";
return $outi;
}
$topic_group = shift @all_topic_groups;
return undef
unless (exists($top_h->{entries}->{$topic_group}));
my $tg_h = $bigh->{entries}->{$topic_group};
my (@topics, @fullnames);
my $maxlen = 4; # minimum name length of four
for my $tp (sort(keys(%{$tg_h->{entries}})))
{
if (defined($topic_pattern))
{
unless ($tp =~ m/$topic_pattern/i)
{
# don't bother with extra check if not a
# comma-separated list of names...
next if ($tp !~ m/\,/);
my @foo = split(/\,/, $tp, 2);
my $gotmatch = 0;
for my $ff (@foo)
{
$ff =~ s/^\s*//;
$ff =~ s/\s*$//;
# special check for keys like "command, alias" --
# try to match the alias
$gotmatch = 1
if ($ff =~ m/$topic_pattern/i);
}
next unless ($gotmatch);
}
}
push @fullnames, $tp;
if ($tp =~ m/\,/)
{
my @foo = split(/\,/, $tp, 2);
$tp = shift @foo;
}
$maxlen = length($tp)
if (length($tp) > $maxlen);
push @topics, $tp;
}
return undef
unless (scalar(@topics));
use POSIX ;
$maxlen += 2; # add two spaces for clarity
my $numcols = POSIX::floor(60/$maxlen);
# $numcols = 5;
# guarantee at least one row
my $numrows = POSIX::ceil(scalar(@topics)/$numcols);
my @outi;
# sort(@topics);
for my $rc1 (1..$numrows)
{
last unless scalar(@topics);
my $tp = shift @topics;
$tp .= ' ' x ($maxlen - length($tp));
push @outi, $tp;
}
while (scalar(@topics))
{
for my $rc1 (0..($numrows-1))
{
last unless scalar(@topics);
my $tp = shift @topics;
$tp .= ' ' x ($maxlen - length($tp));
$outi[$rc1] .= $tp;
}
}
# use Text::Wrap;
# return wrap('','', @topics);
my $msg = "help area=$topic_group\n\n";
$msg .= join("\n", @outi);
if (scalar(@fullnames) == 1)
{
$msg = "";
$format_option = "long";
}
if (scalar(@outi) && ($format_option =~ m/short|long|full/i))
{
$msg .= "\n\n";
for my $name (@fullnames)
{
my $entry = $tg_h->{entries}->{$name};
$msg .= ' ' . $name . ' : ' . $entry->{short_desc} . "\n";
if (($format_option =~ m/long|full/i)
&& exists($entry->{long_desc}))
{
$msg .= $entry->{long_desc} ;
# make sure have trailing newline
$msg .= "\n"
unless ($msg =~ m/\n$/);
}
$msg .= "\n";
}
}
return $msg;
}
END { } # module clean-up code here (global destructor)
1;
## YOUR CODE GOES HERE
if (0)
{
use Data::Dumper;
my $bh = Genezzo::BasicHelp->new();
print Data::Dumper->Dump([$bh]);
my $podtxt = $bh->getpod2text();
print $podtxt, "\n";
my $cmds = $bh->search_topic(topic_group=>'Basic_Commands');
print $cmds, "\n\n";
$cmds = $bh->search_topic(topic_group=>'Basic_Commands',
topic_pattern=>'^d',
option=>'list');
print $cmds, "\n\n";
$cmds = $bh->search_topic(topic_group=>'Basic_Commands',
topic_pattern=>'^.*d',
option=>'full');
print $cmds, "\n\n";
# help area=foo/bar
# help tag=foo,bar,baz
# help list=foo # names only
# help verbose=foo # names and short and full desc
# help foo # names and short desc
}
1; # don't forget to return a true value from the file
__END__
# Below is stub documentation for your module. You better edit it!
=head1 NAME
Genezzo::BasicHelp - Genezzo Help Facility
=head1 SYNOPSIS
use Genezzo::BasicHelp;
=head1 DESCRIPTION
BasicHelp builds searchable data structures out of Pod documents which
are used for the Genezzo Help system. The help system is composed of
a collection of topic groups or areas, with multiple topics in each
group.
BasicHelp Pod documents must follow a specific format -- please see the
following example:
perl -Iblib/lib
-e "use Genezzo::BasicHelp; print Genezzo::BasicHelp::getpod();"
The document must start with a "head1" command which designates the topic
group or area, followed by a paragraph describing the area. The primary
heading is followed by any number of "head2" commands which list the
specific help topics. The format for the topic headings is:
"head2" topic name [, topic alias] : short description
[long description...]
Topics are alphabetically sorted by name, but the alias is a valid
search pattern as well. Note that topic name matching is
case-insensitive.
The "head3" command is reserved for future use -- examples are a
"SEE ALSO" heading which hyperlinks to a related topic, or a "TAGS" field
which groups related help topics.
=head1 ARGUMENTS
none
=head1 FUNCTIONS
=over 4
=item getpod2text
Return the BasicHelp pod document as a formatted text string.
=item search_topic
Find the topics which match the search pattern in a particular group,
and return the results as a formatted string.
The search_topic function takes the following optional named arguments:
=over 4
=item topic_group
A case-insensitve prefix match for a particular group or area.
Default is "Basic_Commands".
=item topic_pattern
A case-insensitive regex to match a specific set of topics in the
group. Defaults to all topics if not specified.
=item option
Output formatting option: LIST (default), SHORT, or LONG.
LIST simply lists the matching topics in a series of columns (similar
to "ls"). SHORT lists the matching topics and then outputs a brief
description for each one. LONG lists the matching topics and then
outputs a full description for each one. Note that if only a single
topic matches then the listing is suppressed and a full description is
always performed.
=back
If no arguments are supplied, search_topic simply lists the available topics
for the default topic group "Basic_Commands".
=item pod2gnzhelp
Take a raw pod help document (as a string) and parse it, updating the
searchable BasicHelp data structure.
=back
=head2 EXPORT
=over 4
=back
=head1 LIMITATIONS
=head1 TODO
=over 4
=item convert hashes back to pod
=item hyperlink "SEE ALSO" headings
=item TAG search
=item hierarchical topic groups and searches
=back
=head1 AUTHOR
Jeffrey I. Cohen, jcohen@genezzo.com
=head1 SEE ALSO
L<perl(1)>.
Copyright (c) 2006, 2007 Jeffrey I Cohen. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Address bug reports and comments to: jcohen@genezzo.com
For more information, please visit the Genezzo homepage
at L<http://www.genezzo.com>
=cut