CGI-Application-Plugin-HelpMan
view release on metacpan or search on metacpan
lib/CGI/Application/Plugin/HelpMan.pm view on Meta::CPAN
# 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[^<>]*>(.+)<\/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 {
( run in 0.943 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )