PDLA-Core

 view release on metacpan or  search on metacpan

Doc/Doc/Perldl.pm  view on Meta::CPAN

    local $SIG{PIPE}= sub {}; # Prevent crashing if user exits the pager

    die 'Usage: doc $topic' unless $#_>-1;
    die "no online doc database" unless defined $PDLA::onlinedoc;
    my $topic = shift;

    # See if it matches a PDLA function name

    my $subfield = $1
      if( $topic =~ s/\[(\d*)\]$// );

    (my $t2 = $topic) =~ s/([^a-zA-Z0-9_])/\\$1/g;  

    my @match = search_docs("m/^(PDLA::)?".$t2."\$/",['Name'],0);

    unless(@match) {
      
      print "No PDLA docs for '$topic'. Using 'whatis'. (Try 'apropos $topic'?)\n\n";
      whatis($topic);
      return;

    }

    # print out the matches

    my $out = IO::File->new( "| pod2text | $PDLA::Doc::pager" );
    
    if($subfield) {
      if($subfield <= @match) {
	@match = ($match[$subfield-1]);
	$subfield = 0;
      } else {
	print $out "\n\n=head1 PDLA HELP: Ignoring out-of-range selector $subfield\n\n=head1\n\n=head1 --------------------------------\n\n";
	$subfield = undef;
      }
    }
    
    my $num_pdl_pod_matches = scalar @match;
    my $pdl_pod_matchnum = 0;

    while (@match) {
       $pdl_pod_matchnum++;

       if (  @match > 1   and   !$subfield  ) {
          print $out "\n\n=head1 MULTIPLE MATCHES FOR HELP TOPIC '$topic':\n\n=head1\n\n=over 3\n\n";
          my $i=0;
          for my $m ( @match ) {
             printf $out "\n=item [%d]\t%-30s %s%s\n\n", ++$i, $m->[0], $m->[1]{Module} && "in ", $m->[1]{CustomFile} || $m->[1]{Module};
          }
          print $out "\n=back\n\n=head1\n\n To see item number \$n, use 'help ${topic}\[\$n\]'. \n\n=cut\n\n";
       }

       if (@match > 0 and $num_pdl_pod_matches > 1) {
          print $out "\n=head1 Displaying item $pdl_pod_matchnum:\n\n=head1 --------------------------------------\n\n=cut\n\n";
       }

       my $m = shift @match;

       my $Ref = $m->[1]{Ref};
       if ( $Ref =~ /^(Module|Manual|Script): / ) {
	   # We've got a file name and we have to open it.  With the relocatable db, we have to reconstitute the absolute pathname.
	   my $relfile = $m->[1]{File};
	   my $absfile = undef;
	   my @scnd = @{$PDLA::onlinedoc->{Scanned}};
	   for my $dbf(@scnd){
	       $dbf =~ s:\/[^\/]*$::; # Trim file name off the end of the database file to get just the directory
	       $dbf .= "/$relfile";
	       $absfile = $dbf if( -e $dbf );
	   }
	   unless ($absfile) {
	       die "Documentation error: couldn't find absolute path to $relfile\n";
	   }
	   my $in = IO::File->new("<$absfile");
	   print $out join("",<$in>);
       } else {
          if(defined $m->[1]{CustomFile}) {

             my $parser= Pod::Select->new;
             print $out "=head1 Autoload file \"".$m->[1]{CustomFile}."\"\n\n";
             $parser->parse_from_file($m->[1]{CustomFile},$out);
             print $out "\n\n=head2 Docs from\n\n".$m->[1]{CustomFile}."\n\n";

          } else {

             print $out "=head1 Module ",$m->[1]{Module}, "\n\n";
             $PDLA::onlinedoc->funcdocs($m->[0],$out);

          }

       }
    }
  }


=head2 find_autodoc

=for ref

Internal helper routine that finds and returns documentation in the autoloader
path, if it exists.  You feed in a topic and it searches for the file
"${topic}.pdl".  If that exists, then the filename gets returned in a 
match structure appropriate for the rest of finddoc.

=cut

# Yuck.  Sorry.  At least it works.  -CED

sub find_autodoc {
    my $topic = shift;
    my $exact = shift;
    my $matcher;
    # Fix up regexps and exact matches for the special case of 
    # searching the autoload dirs...
    if($exact) {
	$topic =~ s/\(\)$//;  # "func()" -> "func"
	$topic .= ".pdl" unless $topic =~ m/\.pdl$/;
    } else {

	$topic =~ s:([^\$])(.)$:$1\.\*\$$2:; # Include explicit ".*$" at end of
	                                   # vague matches -- so that we can
	                                   # make it a ".*\.pdl$" below.



( run in 2.392 seconds using v1.01-cache-2.11-cpan-71847e10f99 )