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 )