package CGI::Application::Plugin::HelpMan; use strict; use warnings; #use base 'CGI::Application'; use LEOCHARRE::DEBUG; use Carp; use Exporter; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); @ISA = qw/ Exporter /; @EXPORT_OK = (qw( __abs_path_doc_to_html __find_abs __string_looks_like_command __term_to_command __term_to_namespace _doc_html _term_abs_path hm_abs_tmp hm_doc_body hm_doc_title hm_found_term_abs hm_found_term_doc hm_found_term_query hm_set_term hm_term_get hm_help_title hm_help_body _hm_reset_data _set_term_as_caller )); %EXPORT_TAGS = ( ALL => \@EXPORT_OK, basic => \@EXPORT_OK, all => \@EXPORT_OK, ); $VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)/g; # 1) is there something to look for? sub hm_found_term_query { my $self = shift; $self->hm_term_get or return 0; return 1; } # 2) can we resolve it to disk? sub hm_found_term_abs { my $self = shift; $self->_term_abs_path or return 0; return 1; } sub _term_abs_path { my $self = shift; $self->{_hm_data_}->{_term_abs_path} ||= __find_abs($self->hm_term_get) or return; return $self->{_hm_data_}->{_term_abs_path} } # 3) does it have doc? sub hm_found_term_doc { my $self = shift; $self->_doc_html or return 0; return 1; } # body text for template sub hm_doc_body { my $self = shift; my $html = $self->_doc_html or return 0; if( $html=~m/]*>(.+)<\/body>/si ){ my $body = $1; # sometimes Pod::Html will output even when there's no doc. my $length = length($html); debug("length $length\n"); # if less then 500, report nothing. $length > 500 or return 0; return $body; } return 0; } # title text for template sub hm_doc_title { my $self = shift; my $title; my $html = $self->_doc_html or return 0; if( $html=~m/]*>(.+)<\/title>/si ){ $title = $1; debug("[$title]via html\n"); return $title; } elsif( $self->hm_term_get ){ my $namespace = __term_to_namespace($self->hm_term_get); debug("[$namespace] via term to namespace\n"); return $namespace; } return 0; } sub hm_abs_tmp { my $self = shift; my $d = $self->param('abs_tmp'); $d ||= '/tmp'; return $d; } # force set the term sub hm_set_term { my $self = shift; my $term = shift; defined $term or confess('missing arg'); $self->{_hm_data_}->{_man_searchterm} = $term; return 1; } # term from query string, then from namespace of caller, your cgi app sub hm_term_get { my $self = shift; unless( $self->{_hm_data_}->{_man_searchterm} ){ # first try from query my $term = $self->query->param('query'); # then from caller $term ||= caller; # was using caller(1), wrong. $self->{_hm_data_}->{_man_searchterm} = $term; debug(" term is [$term]\n"); } return $self->{_hm_data_}->{_man_searchterm}; } # # private methods.... sub _doc_html { my $self = shift; unless(defined $self->{_hm_data_}->{_abs_path_htmlcode}){ unless( $self->_term_abs_path ){ warn("no abs path for term"); $self->{_hm_data_}->{_abs_path_htmlcode} = 0; return 0; } my $help_runmode_name = $self->get_current_runmode; $help_runmode_name ||=undef; $self->{_hm_data_}->{_abs_path_htmlcode} = __abs_path_doc_to_html( $self->_term_abs_path, $self->hm_abs_tmp, $help_runmode_name ); $self->{_hm_data_}->{_abs_path_htmlcode} ||=0; } return $self->{_hm_data_}->{_abs_path_htmlcode}; } # GET TITLE AND BODY FOR THE CALLER, NOT A QUERY sub hm_help_body { my $self = shift; $self->_set_term_as_caller; return $self->hm_doc_body; } sub hm_help_title { my $self = shift; $self->_set_term_as_caller; return $self->hm_doc_title; } sub _set_term_as_caller { my $self = shift; my $caller = caller(1); $caller or confess('caller should return'); unless( $self->hm_term_get eq $caller ){ $self->_hm_reset_data; $self->hm_set_term($caller); } return 1; } sub _hm_reset_data { my $self = shift; $self->{_hm_data_} =undef; return 1; } ####################################################################### # THE FOLLOWING SUBS ARE NOT OO ############################## # get html sub __abs_path_doc_to_html { my ($abs,$tmp,$runmode) = @_; defined $abs and defined $tmp or confess('missing args'); debug("$abs\n"); $runmode ||= 'help_view'; debug("runomde = $runmode"); # can we write to this place, the tmp place? # TODO $self->hm_abs_tmp ? chdir $tmp or confess("$!, cant chdir to $tmp"); # if you dont... breaks. because perl2html ne4eds to write a tmp file require Pod::Html; require File::Slurp; my $out = $tmp.'/helpman_temp_'. (int rand(600000)); debug("$out\n"); Pod::Html::pod2html($abs, "--outfile=$out", # "--verbose", # '--css=http://search.cpan.org/s/style.css' "--htmlroot=?rm=$runmode".'&query=', # WORKS for LINKING ); #TODO needs work up there. my $html = File::Slurp::slurp($out) or warn("could not slurp $out"); # debug("\n\n$html\n\n"); NO return $html; } ##################################### # find on disk sub __find_abs { my $term = shift; $term or confess('missing arg'); my $as_command = __term_to_command($term); my $as_namespace = __term_to_namespace($term); my $abs; require Pod::Simple::Search; my $pss = Pod::Simple::Search->new; if( $abs = $pss->find($as_namespace) ){ debug("via namespace: [$as_namespace] -> $abs\n"); return $abs; } elsif ( defined $as_command ){ require File::Which; $abs = File::Which::which($as_command) or return; debug("via command: [$as_command] -> $abs\n"); require Cwd; Cwd::abs_path( $abs ) or warn("cant resolve $abs") and return; return $abs; } return; } sub __term_to_command { my $term = shift; defined $term or return; $term=~s/^\s+|\s$//g; __string_looks_like_command($term) or return; return $term; } sub __string_looks_like_command { my $string = shift; $string or return; $string=~/^[a-z]+[\w\-]+[a-zA-Z]+$/ or return 0; return 1; } #turn some silly string into a namespace sub __term_to_namespace { my $term = shift ; defined $term or confess('no term arg'); debug($term); $term=~s/^\W|\W$//g; $term=~s/\/+/::/g; $term=~s/\.html?$|\.pm$|\.pl$//g; debug(": $term\n"); return $term; } 1; __END__ =pod =head1 NAME CGI::Application::Plugin::HelpMan - man lookup and help doc for your cgi app =head1 DESCRIPTION I believe that your cgi application should not be an API, it should be a web interface to an API. Just like a script should be a command line interface to an API. Thus documentation in your cgi app should be for the user, not a programmer. If you are of the sentiment your pod documentation in your cgi app should be the docs used for the end user, then this module is for you. =head1 TEMPORARY DIRECTORY Pod::Html needs a temp dir that it can read/write to for tmp files. By default it is /tmp If you want otherwise: my $app = new CGIAPPusingthis( PARAMS => { abs_tmp => '/tmp' } ); =head1 METHODS None are exported by default, you can import all with the export tag ':all'. You can do use CGI::Application::Plugin::HelpMan ':all'; =head2 hm_abs_tmp() Pod::Html needs a temp dir to write to. See L =head2 hm_doc_body() returns body of the html that Pod::Html spat out. =head2 hm_doc_title() returns title of the html that Pod::Html spat out. could be undef =head2 hm_found_term_abs() returns boolean =head2 hm_found_term_doc() =head2 hm_found_term_query() =head2 hm_set_term() force term =head2 hm_term_get() returns term string =head1 PRIVATE METHODS None are exported by default, you can import all public and private methods with the export tag ':all'. =head2 _doc_html() returns what Pod::Html spat out. =head2 _term_abs_path() returns the absolute path the search resolved to for the code (pod) file =head1 SUBROUTINES The following subs are not OO. They can be imported into your code explicitly or with the tag ':ALL'. =head2 __abs_path_doc_to_html() argument is abs path to file tries to get html doc with Pod::Html =head2 __find_abs() argument is a string tries to resolve to disk via File::Which and Pod::Simple::Search =head2 __string_looks_like_command() argument is string, returns boolean - if it looks like a unix command =head2 __term_to_command() argument is string, tries to see if it looks like a unix command, returns command string or undef =head2 __term_to_namespace() argument is string tries to clean up into a perl namespace =head1 CREATING A HELP RUNMODE Imagine you have your cgi app.. "My::App1". Inside App1.pm, make sure your pod doccumentation is present. Then your app needs a help runmode.. sub rm_help { my $self = shift; my $return = sprintf "

%s

%s", $self->hm_help_title, $self->hm_help_body; return $return; } That's it. For a more interesting example, complete with lookup, etc.. see L. If that fails try sub rm_help { my $self = shift; $self->hm_set_term('Your::Package'); my $return = sprintf "

%s

%s", $self->hm_help_title, $self->hm_help_body; return $return; } =head1 AUTHOR Leo Charre leocharre at cpan dot org =head1 SEE ALSO L L =cut