(Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).
| Doc.pm (PDL-2.082) | : | Doc.pm (PDL-2.083) |
|---|
| # the filter for the PDL pod format (which is a valid general perl | | # the filter for the PDL pod format (which is a valid general perl |
| # pod format but with special interpretation of some =for directives) | | # pod format but with special interpretation of some =for directives) |
| | |
| package PDL::PodParser; | | package PDL::PodParser; |
| use strict; | | use strict; |
| use warnings; | | use warnings; |
| use PDL::Core ''; | | use PDL::Core ''; |
| use Pod::Select; | | use Pod::Select; |
|
| use File::Spec; | | |
| use File::Basename; | | |
| | |
| our @ISA = qw(Pod::Select); | | our @ISA = qw(Pod::Select); |
| | |
| our %Title = ('Example' => 'Example', | | our %Title = ('Example' => 'Example', |
| 'Ref' => 'Reference', | | 'Ref' => 'Reference', |
| 'Sig' => 'Signature', | | 'Sig' => 'Signature', |
| 'Opt' => 'Options', | | 'Opt' => 'Options', |
| 'Usage' => 'Usage', | | 'Usage' => 'Usage', |
| 'Bad' => 'Bad value support', | | 'Bad' => 'Bad value support', |
| ); | | ); |
| | |
| skipping to change at line 108 | | skipping to change at line 106 |
|---|
| sub checkmode { | | sub checkmode { |
| my ($this,$txt,$verbatim) = @_; | | my ($this,$txt,$verbatim) = @_; |
| if ($this->{Mode} =~ /NAME/ && $this->{Parmode} =~ /NAME/) { | | if ($this->{Mode} =~ /NAME/ && $this->{Parmode} =~ /NAME/) { |
| $this->{NAME} = $1 if $this->trim($txt) =~ /^\s*(\S+)\s*/; | | $this->{NAME} = $1 if $this->trim($txt) =~ /^\s*(\S+)\s*/; |
| print "\nNAME\t$this->{NAME}\n" if $this->{verbose}; | | print "\nNAME\t$this->{NAME}\n" if $this->{verbose}; |
| $this->{Parmode} = 'Body'; | | $this->{Parmode} = 'Body'; |
| return; | | return; |
| } | | } |
| unless ($this->{Parmode} =~ /Body/ || $this->{INBLOCK}) { | | unless ($this->{Parmode} =~ /Body/ || $this->{INBLOCK}) { |
| my $func = $this->{CURFUNC}; | | my $func = $this->{CURFUNC}; |
|
| barf "no function defined" unless defined $func; | | die "no function defined\n" unless defined $func; |
| local $this->{INBLOCK} = 1; # can interpolate call textblock? | | local $this->{INBLOCK} = 1; # can interpolate call textblock? |
| my $itxt = $verbatim ? $txt : $this->interpolate($txt); | | my $itxt = $verbatim ? $txt : $this->interpolate($txt); |
| $this->{SYMHASH}->{$func}->{$this->{Parmode}} .= | | $this->{SYMHASH}->{$func}->{$this->{Parmode}} .= |
| $this->trim($itxt,$verbatim); | | $this->trim($itxt,$verbatim); |
| my $cr = ($verbatim && $this->{Parmode} ne 'Sig') ? "\n" : ""; | | my $cr = ($verbatim && $this->{Parmode} ne 'Sig') ? "\n" : ""; |
| my $out = "\n\t\t$cr".$this->trim($itxt,$verbatim); | | my $out = "\n\t\t$cr".$this->trim($itxt,$verbatim); |
| print "$out\n$cr" if $this->{verbose}; | | print "$out\n$cr" if $this->{verbose}; |
| } | | } |
| $this->{Parmode} = 'Body'; | | $this->{Parmode} = 'Body'; |
| } | | } |
| | |
| skipping to change at line 158 | | skipping to change at line 156 |
|---|
| return $ntxt; | | return $ntxt; |
| } | | } |
| | |
| =head1 NAME | | =head1 NAME |
| | |
| PDL::Doc - support for PDL online documentation | | PDL::Doc - support for PDL online documentation |
| | |
| =head1 SYNOPSIS | | =head1 SYNOPSIS |
| | |
| use PDL::Doc; | | use PDL::Doc; |
|
| $onlinedc = new PDL::Doc ($docfile); | | $onlinedc = PDL::Doc->new($docfile); |
| @match = $onlinedc->search('m/slice|clump/'); | | @match = $onlinedc->search('m/slice|clump/'); |
| | |
| =head1 DESCRIPTION | | =head1 DESCRIPTION |
| | |
| An implementation of online docs for PDL. | | An implementation of online docs for PDL. |
| | |
| =head1 Using PDL documentation | | =head1 Using PDL documentation |
| | |
| PDL::Doc's main use is in the "help" (synonym "?") and "apropos" | | PDL::Doc's main use is in the "help" (synonym "?") and "apropos" |
| (synonym "??") commands in the perldl shell. PDL::Doc provides the | | (synonym "??") commands in the perldl shell. PDL::Doc provides the |
| | |
| skipping to change at line 386 | | skipping to change at line 384 |
|---|
| a one line description of its intended functionality (suitable for | | a one line description of its intended functionality (suitable for |
| inclusion in a concise reference card). PP defined functions (see L<PDL::PP>) | | inclusion in a concise reference card). PP defined functions (see L<PDL::PP>) |
| should have a I<Sig> field stating their signature. To facilitate | | should have a I<Sig> field stating their signature. To facilitate |
| maintenance of this documentation for such functions the 'Doc' field | | maintenance of this documentation for such functions the 'Doc' field |
| has been introduced into the definition of C<pp_def> (see again L<PDL::PP>) | | has been introduced into the definition of C<pp_def> (see again L<PDL::PP>) |
| which will take care that name and signature of the so defined function | | which will take care that name and signature of the so defined function |
| are documented in this way (for examples of this usage see, for example, | | are documented in this way (for examples of this usage see, for example, |
| the PDL::Slices module, especially F<slices.pd> and the resulting | | the PDL::Slices module, especially F<slices.pd> and the resulting |
| F<Slices.pm>). Similarly, the 'BadDoc' field provides a means of | | F<Slices.pm>). Similarly, the 'BadDoc' field provides a means of |
| specifying information on how the routine handles the presence of | | specifying information on how the routine handles the presence of |
|
| bad values: this will be autpmatically created if | | bad values: this will be automatically created if |
| C<BadDoc> is not supplied, or set to C<undef>. | | C<BadDoc> is not supplied, or set to C<undef>. |
| | |
| Furthermore, the documentation for each function should contain | | Furthermore, the documentation for each function should contain |
| at least one of the I<Usage> or I<Examples> fields. Depending on the | | at least one of the I<Usage> or I<Examples> fields. Depending on the |
| calling conventions for the function under consideration presence | | calling conventions for the function under consideration presence |
| of both fields may be warranted. | | of both fields may be warranted. |
| | |
| If a function has options that should be given as a hash reference in | | If a function has options that should be given as a hash reference in |
| the form | | the form |
| | |
| | |
| skipping to change at line 415 | | skipping to change at line 413 |
|---|
| alternatives. | | alternatives. |
| | |
| =cut | | =cut |
| | |
| package PDL::Doc; | | package PDL::Doc; |
| use strict; | | use strict; |
| use warnings; | | use warnings; |
| use PDL::Core ''; | | use PDL::Core ''; |
| use File::Basename; | | use File::Basename; |
| use PDL::Doc::Config; | | use PDL::Doc::Config; |
|
| | use File::Spec::Functions qw(file_name_is_absolute abs2rel rel2abs catdir catfil |
| | e); |
| | use Cwd (); # to help Debian packaging |
| | |
| =head1 INSTANCE METHODS | | =head1 INSTANCE METHODS |
| | |
| =head2 new | | =head2 new |
| | |
|
| $onlinedc = new PDL::Doc ('file.pdl',[more files]); | | $onlinedc = PDL::Doc->new('file.pdl',[more files]); |
| | |
| =cut | | =cut |
| | |
| sub new { | | sub new { |
| my ($type,@files) = @_; | | my ($type,@files) = @_; |
| my $this = bless {},$type; | | my $this = bless {},$type; |
| $this->{File} = [@files]; | | $this->{File} = [@files]; |
| $this->{Scanned} = []; | | $this->{Scanned} = []; |
| $this->{Outfile} = $files[0]; | | $this->{Outfile} = $files[0]; |
| return $this; | | return $this; |
| | |
| skipping to change at line 465 | | skipping to change at line 465 |
|---|
| | |
| =head2 ensuredb | | =head2 ensuredb |
| | |
| Make sure that the database is slurped in | | Make sure that the database is slurped in |
| | |
| =cut | | =cut |
| | |
| sub ensuredb { | | sub ensuredb { |
| my ($this) = @_; | | my ($this) = @_; |
| while (my $fi = pop @{$this->{File}}) { | | while (my $fi = pop @{$this->{File}}) { |
|
| open IN, $fi or | | open my $fh, $fi or barf "can't open database $fi, scan docs first"; |
| barf "can't open database $fi, scan docs first"; | | binmode $fh; |
| binmode IN; | | |
| my ($plen,$txt); | | my ($plen,$txt); |
|
| while (read IN, $plen,2) { | | while (read $fh, $plen,2) { |
| my ($len) = unpack "S", $plen; | | my ($len) = unpack "S", $plen; |
|
| read IN, $txt, $len; | | read $fh, $txt, $len; |
| my (@a) = split chr(0), $txt; | | my ($sym, $module, @a) = split chr(0), $txt; |
| my $module = splice @a,1,1; | | push @a, "" if @a % 2; # Add null string at end if necessary -- solves bug |
| push(@a, "") unless(@a % 2); # Add null string at end if necessary -- sol | | with missing REF section. |
| ves bug with missing REF section. | | $this->{SYMS}{$sym}{$module} = { @a, Dbfile => $fi }; # keep the origin pd |
| my ($sym, %hash) = @a; | | ldoc.db path |
| | |
| $hash{Dbfile} = $fi; # keep the origin pdldoc.db path | | |
| $this->{SYMS}->{$sym}->{$module} = {%hash}; | | |
| } | | } |
|
| close IN; | | |
| push @{$this->{Scanned}}, $fi; | | push @{$this->{Scanned}}, $fi; |
| } | | } |
| return $this->{SYMS}; | | return $this->{SYMS}; |
| } | | } |
| | |
| =head2 savedb | | =head2 savedb |
| | |
| save the database (i.e., the hash of PDL symbols) to the file associated | | save the database (i.e., the hash of PDL symbols) to the file associated |
| with this object. | | with this object. |
| | |
| =cut | | =cut |
| | |
| sub savedb { | | sub savedb { |
| my ($this) = @_; | | my ($this) = @_; |
|
| my $hash = $this->ensuredb(); | | my $hash = $this->ensuredb; |
| open my $fh, '>', $this->{Outfile} or barf "can't write to symdb $this->{Outfi
le}: $!"; | | open my $fh, '>', $this->{Outfile} or barf "can't write to symdb $this->{Outfi
le}: $!"; |
| binmode $fh; | | binmode $fh; |
| while (my ($name,$mods_hash) = each %$hash) { | | while (my ($name,$mods_hash) = each %$hash) { |
| next if 0 == scalar(%$mods_hash); | | next if 0 == scalar(%$mods_hash); |
|
| while (my ($module,$val) = each %$mods_hash){ | | while (my ($module,$val) = each %$mods_hash) { |
| my $fi = $val->{File}; | | my $fi = $val->{File}; |
|
| if (File::Spec->file_name_is_absolute($fi) && -f $fi) { | | $val->{File} = abs2rel($fi, dirname($this->{Outfile})) |
| #store paths to *.pm files relative to pdldoc.db | | #store paths to *.pm files relative to pdldoc.db |
|
| $val->{File} = File::Spec->abs2rel($fi, dirname($this->{Outfile})) ; | | if file_name_is_absolute($fi) && -f $fi; |
| } | | |
| delete $val->{Dbfile}; # no need to store Dbfile | | delete $val->{Dbfile}; # no need to store Dbfile |
| my $txt = join(chr(0),$name,$module,%$val); | | my $txt = join(chr(0),$name,$module,%$val); |
| print $fh pack("S",length($txt)).$txt; | | print $fh pack("S",length($txt)).$txt; |
| } | | } |
| } | | } |
| } | | } |
| | |
| =head2 gethash | | =head2 gethash |
| | |
|
| Return the PDL symhash (e.g. for custom search operations) | | Return the PDL symhash (e.g. for custom search operations). To see what |
| | it has stored in it in JSON format: |
| | |
| | perl -MPDL::Doc -MJSON::PP -e \ |
| | 'print encode_json +PDL::Doc->new(PDL::Doc::_find_inc([qw(PDL pdldoc.db)]))- |
| | >gethash' | |
| | json_pp -json_opt pretty,canonical |
| | |
| The symhash is a multiply nested hash ref with the following structure: | | The symhash is a multiply nested hash ref with the following structure: |
| | |
| $symhash = { | | $symhash = { |
| function_name => { | | function_name => { |
| module::name => { | | module::name => { |
| Module => 'module::name', | | Module => 'module::name', |
| Sig => 'signature string', | | Sig => 'signature string', |
| Bad => 'bad documentation string', | | Bad => 'bad documentation string', |
| ... | | ... |
| | |
| skipping to change at line 557 | | skipping to change at line 555 |
|---|
| names (ex: the documentation for zeros is under zeroes) | | names (ex: the documentation for zeros is under zeroes) |
| Names - a comma-separated string of all the function's names | | Names - a comma-separated string of all the function's names |
| Example - example text (optional) | | Example - example text (optional) |
| Ref - one-line reference string | | Ref - one-line reference string |
| Opt - options | | Opt - options |
| Usage - short usage explanation | | Usage - short usage explanation |
| Bad - explanation of behavior when it encounters bad values | | Bad - explanation of behavior when it encounters bad values |
| | |
| =cut | | =cut |
| | |
|
| sub gethash { | | sub gethash { $_[0]->ensuredb } |
| return $_[0]->ensuredb(); | | |
| } | | |
| | |
| =head2 search | | =head2 search |
| | |
| Search a PDL symhash | | Search a PDL symhash |
| | |
| =for usage | | =for usage |
| | |
| $onldc->search($regex, $fields [, $sort]) | | $onldc->search($regex, $fields [, $sort]) |
| | |
| Searching is by default case insensitive. Other flags can be | | Searching is by default case insensitive. Other flags can be |
| | |
| skipping to change at line 611 | | skipping to change at line 607 |
|---|
| $sort = 0 unless defined $sort; | | $sort = 0 unless defined $sort; |
| my $hash = $this->ensuredb; | | my $hash = $this->ensuredb; |
| my @match = (); | | my @match = (); |
| | |
| # Make a single scalar $fields work | | # Make a single scalar $fields work |
| $fields = [$fields] if ref($fields) eq ''; | | $fields = [$fields] if ref($fields) eq ''; |
| | |
| $pattern = $this->checkregex($pattern); | | $pattern = $this->checkregex($pattern); |
| | |
| while (my ($name,$mods_hash) = each %$hash) { | | while (my ($name,$mods_hash) = each %$hash) { |
|
| while (my ($module,$val) = each %$mods_hash){ | | while (my ($module,$val) = each %$mods_hash) { |
| FIELD: for (@$fields) { | | FIELD: for (@$fields) { |
| if ($_ eq 'Name' and $name =~ /$pattern/i | | if ($_ eq 'Name' and $name =~ /$pattern/i |
| or defined $val->{$_} and $val->{$_} =~ /$pattern/i) { | | or defined $val->{$_} and $val->{$_} =~ /$pattern/i) { |
| $val = $hash->{$val->{Crossref}}->{$module} #we're going to assum
e that any Crossref'd documentation is also in this module | | $val = $hash->{$val->{Crossref}}->{$module} #we're going to assum
e that any Crossref'd documentation is also in this module |
| if defined $val->{Crossref} && defined $hash->{$val->{Crossref}}-
>{$module}; | | if defined $val->{Crossref} && defined $hash->{$val->{Crossref}}-
>{$module}; |
| push @match, [$name,$module,$val]; | | push @match, [$name,$module,$val]; |
| last FIELD; | | last FIELD; |
| } | | } |
| } | | } |
| } | | } |
| | |
| skipping to change at line 655 | | skipping to change at line 651 |
|---|
| | |
| =head2 scan | | =head2 scan |
| | |
| Scan a source file using the PDL podparser to extract information | | Scan a source file using the PDL podparser to extract information |
| for online documentation | | for online documentation |
| | |
| =cut | | =cut |
| | |
| sub scan { | | sub scan { |
| my ($this,$file,$verbose) = @_; | | my ($this,$file,$verbose) = @_; |
|
| $verbose = 0 unless defined $verbose; | | |
| barf "can't find file '$file'" unless -f $file; | | barf "can't find file '$file'" unless -f $file; |
|
| | | $file = Cwd::abs_path($file); # help Debian packaging |
| # First HTMLify file in the tree | | $verbose = 0 unless defined $verbose; |
| | |
| # Does not work yet | | |
| | |
| #if (system ("pod2html $file")!=0) { | | |
| # warn "Failed to execute command: pod2html $file2\n"; | | |
| #} | | |
| #else{ # Rename result (crummy pod2html) | | |
| # rename ("$file.html","$1.html") if $file =~ /^(.*)\.pm$/; | | |
| #} | | |
| | | |
| # Now parse orig pm/pod | | |
| | |
| open my $infile, '<', $file; | | open my $infile, '<', $file; |
| # XXXX convert to absolute path | | # XXXX convert to absolute path |
| # my $outfile = '/tmp/'.basename($file).'.pod'; | | # my $outfile = '/tmp/'.basename($file).'.pod'; |
| open my $outfile, '>', \(my $outfile_text); | | open my $outfile, '>', \(my $outfile_text); |
| | |
| # Handle RPM etc. case where we are building away from the final | | # Handle RPM etc. case where we are building away from the final |
| # location. Alright it's a hack - KGB | | # location. Alright it's a hack - KGB |
| my $file2 = $file; | | my $file2 = $file; |
| $file2 =~ s/^$ENV{BUILDROOTPREFIX}// if $ENV{BUILDROOTPREFIX}; | | $file2 =~ s/^$ENV{BUILDROOTPREFIX}// if $ENV{BUILDROOTPREFIX}; |
| | |
| my $parser = PDL::PodParser->new; | | my $parser = PDL::PodParser->new; |
| $parser->{verbose} = $verbose; | | $parser->{verbose} = $verbose; |
| eval { $parser->parse_from_filehandle($infile,$outfile) }; | | eval { $parser->parse_from_filehandle($infile,$outfile) }; |
|
| warn "cannot parse '$file' ($@)" if $@; | | warn "cannot parse '$file' ($@)" if $@ and $@ ne "no function defined\n"; |
| | |
|
| $this->{SYMS} = {} unless defined $this->{SYMS}; | | my $hash = $this->{SYMS} ||= {}; |
| my $hash = $this->{SYMS}; | | |
| my @stats = stat $file; | | |
| $this->{FTIME}->{$file2} = $stats[9]; # store last mod time | | |
| # print "mtime of $file: $stats[9]\n"; | | |
| my $n = 0; | | my $n = 0; |
|
| | $_->{File} = $file2, $n++ for values %{ $parser->{SYMHASH} }; |
| while (my ($key,$val) = each %{ $parser->{SYMHASH} }) { | | while (my ($key,$val) = each %{ $parser->{SYMHASH} }) { |
|
| $n++; | | |
| $val->{File} = $file2; | | |
| #set up the 3-layer hash/database structure: $hash->{funcname}->{PDL::SomeMo
dule} = $val | | #set up the 3-layer hash/database structure: $hash->{funcname}->{PDL::SomeMo
dule} = $val |
|
| if (defined($val->{Module})){ | | if (defined($val->{Module})) { |
| $hash->{$key}->{$val->{Module}} = $val; | | $hash->{$key}{$val->{Module}} = $val; |
| } else { | | } else { |
| warn "no Module for $key in $file2\n"; | | warn "no Module for $key in $file2\n"; |
| } | | } |
| } | | } |
| | |
| # KGB pass2 - scan for module name and function | | # KGB pass2 - scan for module name and function |
| # alright I admit this is kludgy but it works | | # alright I admit this is kludgy but it works |
| # and one can now find modules with 'apropos' | | # and one can now find modules with 'apropos' |
| | |
| open $infile, '<', $file; | | open $infile, '<', $file; |
| $outfile_text = ''; | | $outfile_text = ''; |
|
| $parser = new PDL::PodParser; | | $parser = PDL::PodParser->new; |
| $parser->select('NAME'); | | $parser->select('NAME'); |
| eval { $parser->parse_from_filehandle($infile,$outfile) }; | | eval { $parser->parse_from_filehandle($infile,$outfile) }; |
| warn "cannot parse '$file'" if $@; | | warn "cannot parse '$file'" if $@; |
| | |
| my @namelines = split("\n",$outfile_text); | | my @namelines = split("\n",$outfile_text); |
| my ($name,$does); | | my ($name,$does); |
| for (@namelines) { | | for (@namelines) { |
| if (/^(PDL) (-) (.*)/ or /^\s*(Inline::Pdlpp)\s*(-*)?\s*(.*)\s*$/ or /\s*(
PDL::[\w:]*)\s*(-*)?\s*(.*)\s*$/) { | | if (/^(PDL) (-) (.*)/ or /^\s*(Inline::Pdlpp)\s*(-*)?\s*(.*)\s*$/ or /\s*(
PDL::[\w:]*)\s*(-*)?\s*(.*)\s*$/) { |
| $name = $1; $does = $3; | | $name = $1; $does = $3; |
| } | | } |
| | |
| skipping to change at line 748 | | skipping to change at line 727 |
|---|
| documentation) files (using the File::Find module). | | documentation) files (using the File::Find module). |
| | |
| =cut | | =cut |
| | |
| sub scantree { | | sub scantree { |
| my ($this,$dir,$verbose) = @_; | | my ($this,$dir,$verbose) = @_; |
| $verbose = 0 unless defined $verbose; | | $verbose = 0 unless defined $verbose; |
| require File::Find; | | require File::Find; |
| print "Scanning $dir ... \n\n"; | | print "Scanning $dir ... \n\n"; |
| my $ntot = 0; | | my $ntot = 0; |
|
| my $sub = sub { if (($File::Find::name =~ /[.]pm$/ && | | my $sub = sub { |
| $File::Find::name !~ /PP.pm/ && | | return if $File::Find::name !~ /\.(?:pm|pod)$/; |
| $File::Find::name !~ m|Pod/Parser.pm| && | | return if $File::Find::name =~ /(?:Index\.pod|PP\.pm)$/ or |
| $File::Find::dir !~ m#/PP|/Gen#) or ( | | $File::Find::dir =~ m#/PP#; |
| $File::Find::name =~ /[.]pod$/ && | | printf "%-20s", $_.'...'; |
| $File::Find::name !~ /Index[.]pod$/)){ | | $ntot += my $n = $this->scan($File::Find::name,$verbose); |
| printf "%-20s", $_.'...'; | | print "\t$n functions\n"; |
| my $n = $this->scan($File::Find::name,$verbose); # bind $this lexically | | |
| print "\t$n functions\n"; | | |
| $ntot += $n; | | |
| } | | |
| }; | | }; |
| File::Find::find($sub,$dir); | | File::Find::find($sub,$dir); |
|
| print "\n\nfound $ntot functions\n"; | | print "\nfound $ntot functions\n"; |
| | $ntot; |
| } | | } |
| | |
| =head2 funcdocs | | =head2 funcdocs |
| | |
| extract the complete documentation about a function from its | | extract the complete documentation about a function from its |
| source file using the PDL::PodParser filter. | | source file using the PDL::PodParser filter. |
| | |
| =cut | | =cut |
| | |
| sub funcdocs { | | sub funcdocs { |
| my ($this,$func,$module,$fout) = @_; | | my ($this,$func,$module,$fout) = @_; |
| my $hash = $this->ensuredb; | | my $hash = $this->ensuredb; |
| barf "unknown function '$func'" unless defined($hash->{$func}); | | barf "unknown function '$func'" unless defined($hash->{$func}); |
| barf "funcdocs now requires 3 arguments" if defined fileno $module; | | barf "funcdocs now requires 3 arguments" if defined fileno $module; |
|
| my $file = $hash->{$func}->{$module}->{File}; | | my $file = $hash->{$func}{$module}{File}; |
| my $dbf = $hash->{$func}->{$module}->{Dbfile}; | | my $dbf = $hash->{$func}{$module}{Dbfile}; |
| if (!File::Spec->file_name_is_absolute($file) && $dbf) { | | $file = Cwd::abs_path($file) if file_name_is_absolute($file); |
| $file = File::Spec->rel2abs($file, dirname($dbf)); | | $dbf = Cwd::abs_path($dbf); # help Debian packaging |
| } | | $file = rel2abs($file, dirname($dbf)) |
| | if !file_name_is_absolute($file) && $dbf; |
| funcdocs_fromfile($func,$file,$fout); | | funcdocs_fromfile($func,$file,$fout); |
| } | | } |
| | |
| =head1 FUNCTIONS | | =head1 FUNCTIONS |
| | |
| =cut | | =cut |
| | |
| sub funcdocs_fromfile { | | sub funcdocs_fromfile { |
| my ($func,$file) = @_; | | my ($func,$file) = @_; |
| barf "can't find file '$file'" unless -f $file; | | barf "can't find file '$file'" unless -f $file; |
| | |
| skipping to change at line 822 | | skipping to change at line 799 |
|---|
| seek $in,0,0; | | seek $in,0,0; |
| $parser->select("$foo/(.*,\\s+)*$func(\\(.*\\))*(\\s*|,\\s+.*)"); | | $parser->select("$foo/(.*,\\s+)*$func(\\(.*\\))*(\\s*|,\\s+.*)"); |
| $parser->parse_from_filehandle($in,$out); | | $parser->parse_from_filehandle($in,$out); |
| } | | } |
| } | | } |
| | |
| =head2 add_module | | =head2 add_module |
| | |
| =for usage | | =for usage |
| | |
|
| use PDL::Doc; PDL::Doc::add_module("my::module"); | | use PDL::Doc; |
| | PDL::Doc::add_module("PDL::Stats"); # add PDL::Stats, PDL::Stats::GLM, ... |
| | |
| =for ref | | =for ref |
| | |
| The C<add_module> function allows you to add POD from a particular Perl | | The C<add_module> function allows you to add POD from a particular Perl |
|
| module that you've installed somewhere in @INC. It searches for the | | module (and as of PDL 2.083, in fact all modules starting with that as |
| | a prefix) that you've installed somewhere in C<@INC>. It searches for the |
| active PDL document database and the module's .pod and .pm files, and | | active PDL document database and the module's .pod and .pm files, and |
|
| scans and indexes the module into the database. | | scans and indexes the module(s) into the database. |
| | |
| C<add_module> is meant to be added to your module's Makefile as part of the | | C<add_module> is meant to be added to your module's Makefile as part of the |
|
| installation script. | | installation script. This is done automatically by |
| | | L<PDL::Core::Dev/pdlpp_postamble>, but if the top level of your |
| =cut | | distribution is Perl modules (like L<PDL::LinearAlgebra>), then add a |
| | C<postamble> manually in the F<Makefile.PL>: |
| | |
|
| sub add_module { | | use PDL::Core::Dev; |
| my($module) = shift; | | sub MY::postamble { |
| use File::Copy qw{copy}; | | my $oneliner = PDL::Core::Dev::_oneliner(qq{exit if \$ENV{DESTDIR}; use PDL: |
| my($pdldoc); | | :Doc; eval { PDL::Doc::add_module(shift); }}); |
| local($_); | | qq|\ninstall :: pure_install\n\t$oneliner \$(NAME)\n|; |
| DIRECTORY: | | } |
| for my $dir (@INC){ | | |
| my $file = $dir."/PDL/pdldoc.db"; | | |
| if( -f $file) { | | |
| if(! -w "$dir/PDL") { | | |
| die "No write permission at $dir/PDL - not updating docs database | | |
| .\n"; | | |
| } | | |
| print "Found docs database $file\n"; | | |
| $pdldoc = PDL::Doc->new($file); | | |
| last DIRECTORY; | | |
| } | | |
| } | | |
| | |
|
| die "Unable to find docs database - therefore not updating it.\n" unless($pd
ldoc); | | =cut |
| | |
|
| my $mfile = $module; | | sub _find_inc { |
| $mfile =~ s/\:\:/\//g; | | my ($what, $want_dir) = @_; |
| for(@INC){ | | my @ret; |
| my $postfix; | | for my $dir (@INC) { |
| my $hit = 0; | | my $ent = $want_dir ? catdir($dir, @$what) : catfile($dir, @$what); |
| for $postfix(".pm",".pod") { | | push @ret, $ent if $want_dir ? -d $ent : -f $ent; |
| my $f = "$_/$mfile$postfix"; | | } |
| if( -e $f ){ | | @ret; |
| $pdldoc->ensuredb(); | | } |
| $pdldoc->scan($f); | | |
| eval { $pdldoc->savedb(); }; | | |
| warn $@ if $@; | | |
| print "PDL docs database updated - added $f.\n"; | | |
| $hit = 1; | | |
| } | | |
| } | | |
| return if($hit); | | |
| } | | |
| | |
|
| die "Unable to find a .pm or .pod file in \@INC for module $module\n"; | | sub add_module { |
| | my ($module) = @_; |
| | my ($file) = _find_inc([qw(PDL pdldoc.db)], 0); |
| | die "Unable to find docs database - therefore not updating it.\n" if !defined |
| | $file; |
| | die "No write permission for $file - not updating docs database.\n" |
| | if !-w $file; |
| | print "Found docs database $file\n"; |
| | my $pdldoc = PDL::Doc->new($file); |
| | my @pkg = my @mfile = split /::/, $module; |
| | my $mlast = pop @mfile; |
| | my @found = map _find_inc([@mfile, $mlast.$_]), qw(.pm .pod); |
| | die "Unable to find a .pm or .pod file in \@INC for module $module\n" if !@fou |
| | nd; |
| | $pdldoc->ensuredb; |
| | my $n = 0; |
| | $n += $pdldoc->scan($_) for @found; |
| | print "Added @found, $n functions.\n"; |
| | $n += $pdldoc->scantree($_) for _find_inc(\@pkg, 1); |
| | eval { $pdldoc->savedb; }; |
| | warn $@ if $@; |
| | print "PDL docs database updated - total $n functions.\n"; |
| } | | } |
| | |
| =head1 PDL::DOC EXAMPLE | | =head1 PDL::DOC EXAMPLE |
| | |
| Here's an example of how you might use the PDL Doc database in your | | Here's an example of how you might use the PDL Doc database in your |
| own code. | | own code. |
| | |
| use PDL::Doc; | | use PDL::Doc; |
| # Find the pdl documentation | | # Find the pdl documentation |
|
| my ($dir,$file,$pdldoc); | | my ($file) = _find_inc([qw(PDL pdldoc.db)], 0); |
| DIRECTORY: for $dir (@INC) { | | die "Unable to find docs database!\n" unless defined $file; |
| $file = $dir."/PDL/pdldoc.db"; | | print "Found docs database $file\n"; |
| if (-f $file) { | | my $pdldoc = PDL::Doc->new($file); |
| print "Found docs database $file\n"; | | |
| $pdldoc = new PDL::Doc ($file); | | |
| last DIRECTORY; | | |
| } | | |
| } | | |
| | |
| die ("Unable to find docs database!\n") unless $pdldoc; | | |
| | | |
| # Print the reference line for zeroes: | | # Print the reference line for zeroes: |
| print map{$_->{Ref}} values %{$pdldoc->gethash->{zeroes}}; | | print map{$_->{Ref}} values %{$pdldoc->gethash->{zeroes}}; |
| # Or, if you remember that zeroes is in PDL::Core: | | # Or, if you remember that zeroes is in PDL::Core: |
| print $pdldoc->gethash->{zeroes}->{PDL::Core}->{Ref}; | | print $pdldoc->gethash->{zeroes}->{PDL::Core}->{Ref}; |
| | |
| # Get info for all the functions whose examples use zeroes | | # Get info for all the functions whose examples use zeroes |
| my @entries = $pdldoc->search('zeroes','Example',1); | | my @entries = $pdldoc->search('zeroes','Example',1); |
| | |
| # All the functions that use zeroes in their example: | | # All the functions that use zeroes in their example: |
| print "Functions that use 'zeroes' in their examples include:\n"; | | print "Functions that use 'zeroes' in their examples include:\n"; |
| foreach my $entry (@entries) { | | foreach my $entry (@entries) { |
| # Unpack the entry | | # Unpack the entry |
| my ($func_name, $module, $sym_hash) = @$entry; | | my ($func_name, $module, $sym_hash) = @$entry; |
| print "$func_name\n"; | | print "$func_name\n"; |
| } | | } |
| print "\n"; | | print "\n"; |
| | |
| #Or, more concisely: | | #Or, more concisely: |
|
| print join("\n",map{$_->[0]}@entries); | | print map "$_->[0]\n", @entries; |
| | |
| # Let's look at the function 'mpdl' | | # Let's look at the function 'mpdl' |
| @entries = $pdldoc->search('mpdl', 'Name'); | | @entries = $pdldoc->search('mpdl', 'Name'); |
| # I know there's only one: | | # I know there's only one: |
| my $entry = $entries[0]; | | my $entry = $entries[0]; |
| my ($func_name, undef, $sym_hash) = @$entry; | | my ($func_name, undef, $sym_hash) = @$entry; |
| print "mpdl info:\n"; | | print "mpdl info:\n"; |
| foreach my $key (sort keys %$sym_hash) { | | foreach my $key (sort keys %$sym_hash) { |
| # Unpack the entry | | # Unpack the entry |
| print "---$key---\n$sym_hash->{$key}\n"; | | print "---$key---\n$sym_hash->{$key}\n"; |
| | | |
| End of changes. 38 change blocks. |
|---|
| 129 lines changed or deleted | | 104 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 