1=head1 NAME 2 3PDL::Doc::Perldl - commands for accessing PDL doc database from 'perldl' shell 4 5=head1 DESCRIPTION 6 7This module provides a simple set of functions to 8access the PDL documentation of database, for use 9from the I<perldl> or I<pdl2> shells as well as the 10I<pdldoc> command-line program. 11 12Autoload files are also matched, via a search of the PDLLIB autoloader 13tree. That behavior can be switched off with the variable 14C<$PERLDL::STRICT_DOCS> (true: don't search autoload tree; false: search 15the autoload tree.) 16 17Currently, multiple matches are not handled very well. 18 19=head1 SYNOPSIS 20 21 use PDL::Doc::Perldl; # Load all documentation functions 22 23=head1 BUGS 24 25The description contains the misleading word "simple". 26 27=head1 FUNCTIONS 28 29=cut 30 31package PDL::Doc::Perldl; 32 33use Exporter; 34use strict; 35use vars qw(@ISA @EXPORT); 36 37@ISA = qw(Exporter); 38 39@EXPORT = qw( apropos aproposover usage help sig badinfo whatis ); 40 41use PDL::Doc; 42use Pod::Select; 43use IO::File; 44use Pod::PlainText; 45 46$PDL::onlinedoc = undef; 47$PDL::onlinedoc = PDL::Doc->new(FindStdFile()); 48 49use PDL::Config; 50my $bvalflag = $PDL::Config{WITH_BADVAL} || 0; 51 52# Find std file 53 54sub FindStdFile { 55 my ($d,$f); 56 for $d (@INC) { 57 $f = $d."/PDL/pdldoc.db"; 58 if (-f $f) { 59 print "Found docs database $f\n" if $PDL::verbose; 60 print "Type 'help' for online help\n" if $PDL::verbose; 61 return $f; 62 } 63 } 64 warn "Unable to find PDL/pdldoc.db in ".join(":",@INC)."\n"; 65} 66 67# used to find out how wide the screen should be 68# for printmatch() - really should check for a 69# sensible lower limit (for printmatch >~ 40 70# would be my guess) 71# 72# taken from Pod::Text (v1.0203), then hacked to get it 73# to work (at least on my solaris and linux 74# machines) 75# 76sub screen_width() { 77 return $ENV{COLUMNS} 78 || (($ENV{TERMCAP} =~ /co#(\d+)/) and $1) 79 || ($^O ne 'MSWin32' and $^O ne 'dos' and 80 (`stty -a 2>/dev/null` =~ /columns\s*=?\s*(\d+)/) and $1) 81 || 72; 82} 83 84sub printmatch { 85 my @match = @_; 86 if (@match) { 87 foreach my $t ( format_ref( @_ ) ) { print $t; } 88 } else { 89 print "no match\n\n"; 90 } 91} # sub: print_match() 92 93# return a string containing a formated version of the Ref string 94# for the given matches 95# 96sub format_ref { 97 my @match = @_; 98 my @text = (); 99 100 my $width = screen_width()-17; 101 my $parser = new Pod::PlainText( width => $width, indent => 0, sentence => 0 ); 102 103 for my $m (@match) { 104 my $ref = $m->[1]{Ref} || 105 ( (defined $m->[1]{CustomFile}) 106 ? "[No ref avail. for `".$m->[1]{CustomFile}."']" 107 : "[No reference available]" 108 ); 109 110 $ref = $parser->interpolate( $ref ); 111 $ref = $parser->reformat( $ref ); 112 113 # remove last new lines (so substitution doesn't append spaces at end of text) 114 $ref =~ s/\n*$//; 115 $ref =~ s/\n/\n /g; 116 117 my $name = $m->[0]; 118 if ( length($name) > 15 ) { 119 push @text, sprintf "%s ...\n %s\n", $name, $ref; 120 } else { 121 push @text, sprintf "%-15s %s\n", $name, $ref; 122 } 123 } 124 return wantarray ? @text : $text[0]; 125 126} # sub: format_ref() 127 128=head2 apropos 129 130=for ref 131 132Regex search PDL documentation database 133 134=for usage 135 136 apropos 'text' 137 138=for example 139 140 pdl> apropos 'pic' 141 rpic Read images in many formats with automatic format detection. 142 rpiccan Test which image formats can be read/written 143 wmpeg Write an image sequence ((x,y,n) piddle) as an MPEG animation. 144 wpic Write images in many formats with automatic format selection. 145 wpiccan Test which image formats can be read/written 146 147To find all the manuals that come with PDL, try 148 149 apropos 'manual:' 150 151and to get quick info about PDL modules say 152 153 apropos 'module:' 154 155You get more detailed info about a PDL function/module/manual 156with the C<help> function 157 158=cut 159 160sub aproposover { 161 die "Usage: aproposover \$funcname\n" unless $#_>-1; 162 die "no online doc database" unless defined $PDL::onlinedoc; 163 my $func = shift; 164 $func =~ s:\/:\\\/:g; 165 search_docs("m/$func/",['Name','Ref','Module'],1); 166 167} 168 169sub apropos { 170 die "Usage: apropos \$funcname\n" unless $#_>-1; 171 die "no online doc database" unless defined $PDL::onlinedoc; 172 my $func = shift; 173 printmatch aproposover $func; 174} 175 176=head2 PDL::Doc::Perldl::search_docs 177 178=for ref 179 180Internal routine to search docs database and autoload files 181 182=cut 183 184sub search_docs { 185 my ($func,$types,$sortflag,$exact) = @_; 186 my @match; 187 188 @match = $PDL::onlinedoc->search($func,$types,$sortflag); 189 push(@match,find_autodoc( $func, $exact ) ); 190 191 @match; 192} 193 194 195 196=head2 PDL::Doc::Perldl::finddoc 197 198=for ref 199 200Internal interface to the PDL documentation searcher 201 202=cut 203 204sub finddoc { 205 local $SIG{PIPE}= sub {}; # Prevent crashing if user exits the pager 206 207 die 'Usage: doc $topic' unless $#_>-1; 208 die "no online doc database" unless defined $PDL::onlinedoc; 209 my $topic = shift; 210 211 # See if it matches a PDL function name 212 213 my $subfield = $1 214 if( $topic =~ s/\[(\d*)\]$// ); 215 216 (my $t2 = $topic) =~ s/([^a-zA-Z0-9_])/\\$1/g; 217 218 my @match = search_docs("m/^(PDL::)?".$t2."\$/",['Name'],0); 219 220 unless(@match) { 221 222 print "No PDL docs for '$topic'. Using 'whatis'. (Try 'apropos $topic'?)\n\n"; 223 whatis($topic); 224 return; 225 226 } 227 228 # print out the matches 229 230 my $out = IO::File->new( "| pod2text | $PDL::Doc::pager" ); 231 232 if($subfield) { 233 if($subfield <= @match) { 234 @match = ($match[$subfield-1]); 235 $subfield = 0; 236 } else { 237 print $out "\n\n=head1 PDL HELP: Ignoring out-of-range selector $subfield\n\n=head1\n\n=head1 --------------------------------\n\n"; 238 $subfield = undef; 239 } 240 } 241 242 my $num_pdl_pod_matches = scalar @match; 243 my $pdl_pod_matchnum = 0; 244 245 while (@match) { 246 $pdl_pod_matchnum++; 247 248 if ( @match > 1 and !$subfield ) { 249 print $out "\n\n=head1 MULTIPLE MATCHES FOR HELP TOPIC '$topic':\n\n=head1\n\n=over 3\n\n"; 250 my $i=0; 251 for my $m ( @match ) { 252 printf $out "\n=item [%d]\t%-30s %s%s\n\n", ++$i, $m->[0], $m->[1]{Module} && "in ", $m->[1]{CustomFile} || $m->[1]{Module}; 253 } 254 print $out "\n=back\n\n=head1\n\n To see item number \$n, use 'help ${topic}\[\$n\]'. \n\n=cut\n\n"; 255 } 256 257 if (@match > 0 and $num_pdl_pod_matches > 1) { 258 print $out "\n=head1 Displaying item $pdl_pod_matchnum:\n\n=head1 --------------------------------------\n\n=cut\n\n"; 259 } 260 261 my $m = shift @match; 262 263 my $Ref = $m->[1]{Ref}; 264 if ( $Ref =~ /^(Module|Manual|Script): / ) { 265 # We've got a file name and we have to open it. With the relocatable db, we have to reconstitute the absolute pathname. 266 my $relfile = $m->[1]{File}; 267 my $absfile = undef; 268 my @scnd = @{$PDL::onlinedoc->{Scanned}}; 269 for my $dbf(@scnd){ 270 $dbf =~ s:\/[^\/]*$::; # Trim file name off the end of the database file to get just the directory 271 $dbf .= "/$relfile"; 272 $absfile = $dbf if( -e $dbf ); 273 } 274 unless ($absfile) { 275 die "Documentation error: couldn't find absolute path to $relfile\n"; 276 } 277 my $in = IO::File->new("<$absfile"); 278 print $out join("",<$in>); 279 } else { 280 if(defined $m->[1]{CustomFile}) { 281 282 my $parser= Pod::Select->new; 283 print $out "=head1 Autoload file \"".$m->[1]{CustomFile}."\"\n\n"; 284 $parser->parse_from_file($m->[1]{CustomFile},$out); 285 print $out "\n\n=head2 Docs from\n\n".$m->[1]{CustomFile}."\n\n"; 286 287 } else { 288 289 print $out "=head1 Module ",$m->[1]{Module}, "\n\n"; 290 $PDL::onlinedoc->funcdocs($m->[0],$out); 291 292 } 293 294 } 295 } 296 } 297 298 299=head2 find_autodoc 300 301=for ref 302 303Internal helper routine that finds and returns documentation in the autoloader 304path, if it exists. You feed in a topic and it searches for the file 305"${topic}.pdl". If that exists, then the filename gets returned in a 306match structure appropriate for the rest of finddoc. 307 308=cut 309 310# Yuck. Sorry. At least it works. -CED 311 312sub find_autodoc { 313 my $topic = shift; 314 my $exact = shift; 315 my $matcher; 316 # Fix up regexps and exact matches for the special case of 317 # searching the autoload dirs... 318 if($exact) { 319 $topic =~ s/\(\)$//; # "func()" -> "func" 320 $topic .= ".pdl" unless $topic =~ m/\.pdl$/; 321 } else { 322 323 $topic =~ s:([^\$])(.)$:$1\.\*\$$2:; # Include explicit ".*$" at end of 324 # vague matches -- so that we can 325 # make it a ".*\.pdl$" below. 326 327 $topic =~ s:\$(.)$:\.pdl\$$1:; # Force ".pdl" at end of file match 328 329 $matcher = eval "sub { ${topic}i && \$\_ };"; # Avoid multiple compiles 330 } 331 332 my @out; 333 334 return unless(@main::PDLLIB); 335 @main::PDLLIB_EXPANDED = PDL::AutoLoader::expand_path(@main::PDLLIB) 336 unless(@main::PDLLIB_EXPANDED); 337 338 for my $dir(@main::PDLLIB_EXPANDED) { 339 if($exact) { 340 my $file = $dir . "/" . "$topic"; 341 push(@out, 342 [$file, {CustomFile => "$file", Module => "file '$file'"}] 343 ) 344 if(-e $file); 345 } else { 346 opendir(FOO,$dir) || next; 347 my @dir = readdir(FOO); 348 closedir(FOO); 349 for my $file( grep( &$matcher, @dir ) ) { 350 push(@out, 351 [$file, {CustomFile => "$dir/$file", Module => "file '$dir/$file'"}] 352 ); 353 } 354 355 } 356 } 357 @out; 358} 359 360 361=head2 usage 362 363=for ref 364 365Prints usage information for a PDL function 366 367=for usage 368 369 Usage: usage 'func' 370 371=for example 372 373 pdl> usage 'inner' 374 375 inner inner prodcuct over one dimension 376 (Module PDL::Primitive) 377 378 Signature: inner(a(n); b(n); [o]c(); ) 379 380 381=cut 382 383sub usage { 384 die 'Usage: usage $funcname' unless $#_>-1; 385 die "no online doc database" unless defined $PDL::onlinedoc; 386 print usage_string(@_); 387} 388sub usage_string{ 389 my $func = shift; 390 my $str = ""; 391 my @match = search_docs("m/^(PDL::)?$func\$/",['Name']); 392 393 unless (@match) { $str = "\n no match\n" } 394 else { 395 $str .= "\n" . format_ref( $match[0] ); 396 my ($name,$hash) = @{$match[0]}; 397 $str .= sprintf ( (' 'x16)."(Module %s)\n\n", $hash->{Module} ); 398 die "No usage info found for $func\n" 399 if !defined $hash->{Example} && !defined $hash->{Sig} && 400 !defined $hash->{Usage}; 401 $str .= " Signature: $name($hash->{Sig})\n\n" if defined $hash->{Sig}; 402 for (['Usage','Usage'],['Opt','Options'],['Example','Example']) { 403 $str .= " $_->[1]:\n\n".&allindent($hash->{$_->[0]},10)."\n\n" 404 if defined $hash->{$_->[0]}; 405 } 406 } 407 return $str; 408} 409 410=head2 sig 411 412=for ref 413 414prints signature of PDL function 415 416=for usage 417 418 sig 'func' 419 420The signature is the normal dimensionality of the 421function's arguments. Calling with different dimensions 422doesn't break -- it causes threading. See L<PDL::PP|PDL::PP> for details. 423 424=for example 425 426 pdl> sig 'outer' 427 Signature: outer(a(n); b(m); [o]c(n,m); ) 428 429 430=cut 431 432sub sig { 433 die "Usage: sig \$funcname\n" unless $#_>-1; 434 die "no online doc database" unless defined $PDL::onlinedoc; 435 my $func = shift; 436 my @match = search_docs("m/^(PDL::)?$func\$/",['Name']); 437 unless (@match) { print "\n no match\n" } else { 438 my ($name,$hash) = @{$match[0]}; 439 die "No signature info found for $func\n" 440 if !defined $hash->{Sig}; 441 print " Signature: $name($hash->{Sig})\n" if defined $hash->{Sig}; 442 } 443} 444 445sub allindent { 446 my ($txt,$n) = @_; 447 my ($ntxt,$tspc) = ($txt,' 'x8); 448 $ntxt =~ s/^\s*$//mg; 449 $ntxt =~ s/\t/$tspc/g; 450 my $minspc = length $txt; 451 for (split '\n', $txt) { if (/^(\s*)/) 452 { $minspc = length $1 if length $1 < $minspc } } 453 $n -= $minspc; 454 $tspc = ' 'x abs($n); 455 $ntxt =~ s/^/$tspc/mg if $n > 0; 456 return $ntxt; 457} 458 459 460=head2 whatis 461 462=for ref 463 464Describe a perl and/or PDL variable or expression. Useful for 465determining the type of an expression, identifying the keys in a hash 466or a data structure, or examining WTF an unknown object is. 467 468=for usage 469 470 Usage: whatis $var 471 whatis <expression> 472 473=cut 474 475sub whatis { 476 my $topic; 477 478 if(@_ > 1) { 479 whatis_r('',0,[@_]); 480 } else { 481 whatis_r('',0,shift); 482 } 483} 484 485$PDL::Doc::Perldl::max_strlen = 55; 486$PDL::Doc::Perldl::max_arraylen = 1; 487$PDL::Doc::Perldl::max_keylen = 8; 488$PDL::Doc::Perldl::array_indent=5; 489$PDL::Doc::Perldl::hash_indent=3; 490 491sub whatis_r { 492 my $prefix = shift; 493 my $indent = shift; 494 my $a = shift; 495 496 unless(defined $a) { 497 print $prefix,"<undef>\n"; 498 return; 499 } 500 501 unless(ref $a) { 502 print "${prefix}'". 503 substr($a,0,$PDL::Doc::Perldl::max_strlen). 504 "'".((length $a > $PDL::Doc::Perldl::max_strlen) && '...'). 505 "\n"; 506 return; 507 } 508 509 if(ref $a eq 'ARRAY') { 510 print "${prefix}Array (".scalar(@$a)." elements):\n"; 511 512 my($el); 513 for $el(0..$#$a) { 514 my $pre = sprintf("%s %2d: "," "x$indent,$el); 515 whatis_r($pre,$indent + $PDL::Doc::Perldl::array_indent, $a->[$el]); 516 last if($el == $PDL::Doc::Perldl::max_arraylen); 517 } 518 printf "%s ... \n"," " x $indent 519 if($#$a > $PDL::Doc::Perldl::max_arraylen); 520 521 return; 522 } 523 524 if(ref $a eq 'HASH') { 525 print "${prefix}Hash (".scalar(keys %$a)." elements)\n"; 526 my $key; 527 for $key(sort keys %$a) { 528 my $pre = " " x $indent . 529 " $key: " . 530 (" "x($PDL::Doc::Perldl::max_keylen - length($key))) ; 531 532 whatis_r($pre,$indent + $PDL::Doc::Perldl::hash_indent, $a->{$key}); 533 } 534 return; 535 } 536 537 if(ref $a eq 'CODE') { 538 print "${prefix}Perl CODE ref\n"; 539 return; 540 } 541 542 if(ref $a eq 'SCALAR' | ref $a eq 'REF') { 543 whatis_r($prefix." Ref -> ",$indent+8,$$a); 544 return; 545 } 546 547 if(UNIVERSAL::can($a,'px')) { 548 my $b; 549 local $PDL::debug = 1; 550 551 $b = ( (UNIVERSAL::isa($a,'PDL') && $a->nelem < 5 && $a->ndims < 2) 552 ? 553 ": $a" : 554 ": *****" 555 ); 556 557 $a->px($prefix.(ref $a)." %7T (%D) ".$b); 558 559 } else { 560 561 print "${prefix}Object: ".ref($a)."\n"; 562 563 } 564} 565 566=head2 help 567 568=for ref 569 570print documentation about a PDL function or module or show a PDL manual 571 572In the case of multiple matches, the first command found is printed out, 573and the remaining commands listed, along with the names of their modules. 574 575 576=for usage 577 578 Usage: help 'func' 579 580=for example 581 582 pdl> help 'PDL::Tutorials' # show the guide to PDL tutorials 583 pdl> help 'PDL::Slices' # show the docs in the PDL::Slices module 584 pdl> help 'slice' # show docs on the 'slice' function 585 586=cut 587 588sub help_url { 589 local $_; 590 foreach(@INC) { 591 my $a = "$_/PDL/HtmlDocs/PDL/Index.html"; 592 if(-e $a) { 593 return "file://$a"; 594 } 595 } 596} 597 598sub help { 599 if ($#_>-1) { 600 require PDL::Dbg; 601 my $topic = shift; 602 if (PDL::Core::blessed($topic) && $topic->can('px')) { 603 local $PDL::debug = 1; 604 $topic->px('This variable is'); 605 } else { 606 $topic = 'PDL::Doc::Perldl' if $topic =~ /^\s*help\s*$/i; 607 if ($topic =~ /^\s*vars\s*$/i) { 608 PDL->px((caller)[0]); 609 } elsif($topic =~ /^\s*url\s*/i) { 610 my $a = help_url(); 611 if($a) { 612 print $a; 613 } else { 614 print "Hmmm. Curious: I couldn't find the HTML docs anywhere in \@INC...\n"; 615 } 616 } elsif($topic =~ /^\s*www(:([^\s]+))?\s*/i) { 617 my $browser; 618 my $url = help_url(); 619 if($2) { 620 $browser = $2; 621 } elsif($ENV{PERLDL_WWW}) { 622 $browser = $ENV{PERLDL_WWW}; 623 } else { 624 $browser = 'mozilla'; 625 } 626 chomp($browser = `which $browser`); 627 if(-e $browser && -x $browser) { 628 print "Spawning \"$browser $url\"...\n"; 629 `$browser $url`; 630 } 631 } else { 632 finddoc($topic); 633 } 634 } 635 } else { 636 print <<'EOH'; 637 638The following commands support online help in the perldl shell: 639 640 help 'thing' -- print docs on 'thing' (func, module, manual, autoload-file) 641 help vars -- print information about all current piddles 642 help url -- locate the HTML version of the documentation 643 help www -- View docs with default web browser (set by env: PERLDL_WWW) 644 645 whatis <expr> -- Describe the type and structure of an expression or piddle. 646 apropos 'word' -- search for keywords/function names 647 usage -- print usage information for a given PDL function 648 sig -- print signature of PDL function 649 650 ('?' is an alias for 'help'; '??' is an alias for 'apropos'.) 651EOH 652 653print " badinfo -- information on the support for bad values\n" 654 if $bvalflag; 655 656print <<'EOH'; 657 658Quick start: 659 apropos 'manual:' -- Find all the manual documents 660 apropos 'module:' -- Quick summary of all PDL modules 661 help 'help' -- details about PDL help system 662 help 'perldl' -- help about this shell 663 664EOH 665 } 666} 667 668=head2 badinfo 669 670=for ref 671 672provides information on the bad-value support of a function 673 674And has a horrible name. 675 676=for usage 677 678 badinfo 'func' 679 680=cut 681 682# need to get this to format the output - want a format_bad() 683# subroutine that's like - but much simpler - than format_ref() 684# 685sub badinfo { 686 my $func = shift; 687 die "Usage: badinfo \$funcname\n" unless defined $func; 688 689 die "PDL has not been compiled with support for bad values.\n" . 690 "Recompile with WITH_BADVAL set to 1 in config file!.\n" 691 unless $bvalflag; 692 693 die "no online doc database" unless defined $PDL::onlinedoc; 694 695 local $SIG{PIPE}= sub {}; # Prevent crashing if user exits the pager 696 697 my @match = search_docs("m/^(PDL::)?$func\$/",['Name']); 698 if ( @match ) { 699 my ($name,$hash) = @{$match[0]}; 700 my $info = $hash->{Bad}; 701 702 if ( defined $info ) { 703 my $out = new IO::File "| pod2text | $PDL::Doc::pager"; 704 print $out "=head1 Bad value support for $name\n\n$info\n"; 705 } else { 706 print "\n No information on bad-value support found for $func\n"; 707 } 708 } else { 709 print "\n no match\n"; 710 } 711} # sub: badinfo() 712 7131; # OK 714