Doc.pm (PDL-2.074) | : | Doc.pm (PDL-2.075) | ||
---|---|---|---|---|
skipping to change at line 27 | skipping to change at line 27 | |||
'Opt' => 'Options', | 'Opt' => 'Options', | |||
'Usage' => 'Usage', | 'Usage' => 'Usage', | |||
'Bad' => 'Bad value support', | 'Bad' => 'Bad value support', | |||
); | ); | |||
sub new { | sub new { | |||
my $class = shift; | my $class = shift; | |||
my $parser = $class->SUPER::new(@_); | my $parser = $class->SUPER::new(@_); | |||
bless $parser,$class; # just in case | bless $parser,$class; # just in case | |||
$parser->select("METHODS|OPERATORS|CONTRUCTORS|FUNCTIONS|NAME"); | $parser->select("METHODS|OPERATORS|CONSTRUCTORS|FUNCTIONS|NAME"); | |||
$parser->{CURFUNC} = undef; | $parser->{CURFUNC} = undef; | |||
$parser->{SYMHASH} = {}; | $parser->{SYMHASH} = {}; | |||
$parser->{INBLOCK} = 0; | $parser->{INBLOCK} = 0; | |||
$parser->{Mode} = ""; | $parser->{Mode} = ""; | |||
$parser->{verbose} = 0; | $parser->{verbose} = 0; | |||
$parser->{NAME} = 'UNKNOWN'; | $parser->{NAME} = 'UNKNOWN'; | |||
return $parser; | return $parser; | |||
} | } | |||
sub command { | sub command { | |||
my ($this,$cmd,$txt,$line_num,$pod_para) = @_; | my ($this,$cmd,$txt,$line_num,$pod_para) = @_; | |||
$this->{Parmode} = 'Body'; | $this->{Parmode} = 'Body'; | |||
if ($cmd eq 'head1') { | if ($cmd eq 'head1') { | |||
$this->{Mode} = $txt; | $this->{Mode} = $txt; | |||
$this->{Parmode} = 'Body'; | $this->{Parmode} = 'Body'; | |||
$this->{Parmode} = 'NAME' if $txt =~ /NAME/; | $this->{Parmode} = 'NAME' if $txt =~ /NAME/; | |||
} elsif ($this->{Mode} =~ /NAME/) { | } elsif ($this->{Mode} =~ /NAME/) { | |||
# do nothing (was 'last' but that was probably a mistake) | # do nothing (was 'last' but that was probably a mistake) | |||
} elsif ($cmd eq 'head2') { | } elsif ($cmd eq 'head2') { | |||
return $this->SUPER::command($cmd,$txt,$line_num,$pod_para) if $txt =~ /^The \s/; # heuristic to deal with GSL::CDF descriptive =head2 | ||||
# A function can have multiple names (ex: zeros and zeroes), | # A function can have multiple names (ex: zeros and zeroes), | |||
# so split at the commas | # so split at the commas | |||
my @funcs = split(',',$txt); | my @funcs = split(',',$txt); | |||
# Remove parentheses (so myfunc and myfunc() both work) | # Remove parentheses (so myfunc and myfunc() both work) | |||
my @names = map {$1 if m/\s*([^\s(]+)\s*/} @funcs; | my @names = map {$1 if m/\s*([^\s\(]+)\s*/} @funcs; | |||
barf "error parsing function list '$txt'" | barf "error parsing function list '$txt'" | |||
unless $#funcs == $#names; | unless $#funcs == $#names; | |||
# check for signatures | # check for signatures | |||
my $sym = $this->{SYMHASH}; | my $sym = $this->{SYMHASH}; | |||
for (@funcs) { | for (@funcs) { | |||
$sym->{$1}->{Module} = $this->{NAME} if m/\s*([^\s(]+)\s*/; | $sym->{$1}->{Module} = $this->{NAME} if m/\s*([^\s(]+)\s*/; | |||
$sym->{$1}->{Sig} = $2 if m/\s*([^\s(]+)\s*\(\s*(.+)\s*\)\s*$/; | $sym->{$1}->{Sig} = $2 if m/\s*([^\s(]+)\s*\(\s*(.+)\s*\)\s*$/; | |||
} | } | |||
# make the first one the current function | # make the first one the current function | |||
$sym->{$names[0]}->{Names} = join(',',@names) if $#names > 0; | $sym->{$names[0]}->{Names} = join(',',@names) if $#names > 0; | |||
skipping to change at line 409 | skipping to change at line 410 | |||
in the textblock following the C<=for Opt> directive (see example above | in the textblock following the C<=for Opt> directive (see example above | |||
and, e.g., PDL::IO::Pic). | and, e.g., PDL::IO::Pic). | |||
It is well possible that some of these conventions appear to be clumsy | It is well possible that some of these conventions appear to be clumsy | |||
at times and the author is keen to hear of any suggestions for better | at times and the author is keen to hear of any suggestions for better | |||
alternatives. | alternatives. | |||
=cut | =cut | |||
package PDL::Doc; | package PDL::Doc; | |||
use strict; | ||||
use warnings; | ||||
use PDL::Core ''; | use PDL::Core ''; | |||
use File::Basename; | use File::Basename; | |||
use PDL::Doc::Config; | use PDL::Doc::Config; | |||
=head1 INSTANCE METHODS | =head1 INSTANCE METHODS | |||
=head2 new | =head2 new | |||
$onlinedc = new PDL::Doc ('file.pdl',[more files]); | $onlinedc = new PDL::Doc ('file.pdl',[more files]); | |||
skipping to change at line 678 | skipping to change at line 681 | |||
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 = new PDL::PodParser; | 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 $@; | |||
$this->{SYMS} = {} unless defined $this->{SYMS}; | $this->{SYMS} = {} unless defined $this->{SYMS}; | |||
my $hash = $this->{SYMS}; | my $hash = $this->{SYMS}; | |||
my @stats = stat $file; | my @stats = stat $file; | |||
$this->{FTIME}->{$file2} = $stats[9]; # store last mod time | $this->{FTIME}->{$file2} = $stats[9]; # store last mod time | |||
# print "mtime of $file: $stats[9]\n"; | # print "mtime of $file: $stats[9]\n"; | |||
my $phash = $parser->{SYMHASH}; | ||||
my $n = 0; | my $n = 0; | |||
while (my ($key,$val) = each %$phash) { | while (my ($key,$val) = each %{ $parser->{SYMHASH} }) { | |||
$n++; | $n++; | |||
$val->{File} = $file2; | $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 = new PDL::PodParser; | |||
$parser->select('NAME'); | $parser->select('NAME'); | |||
eval { $parser->parse_from_filehandle($infile,$outfile) }; | eval { $parser->parse_from_filehandle($infile,$outfile) }; | |||
skipping to change at line 836 | skipping to change at line 836 | |||
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 that you've installed somewhere in @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 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. | |||
=cut | =cut | |||
package PDL::Doc; | ||||
sub add_module { | sub add_module { | |||
my($module) = shift; | my($module) = shift; | |||
use File::Copy qw{copy}; | use File::Copy qw{copy}; | |||
my($pdldoc); | ||||
my($dir, $file, $pdldoc); | ||||
local($_); | local($_); | |||
DIRECTORY: | DIRECTORY: | |||
for(@INC){ | for my $dir (@INC){ | |||
$dir = $_; | my $file = $dir."/PDL/pdldoc.db"; | |||
$file = $dir."/PDL/pdldoc.db"; | ||||
if( -f $file) { | if( -f $file) { | |||
if(! -w "$dir/PDL") { | if(! -w "$dir/PDL") { | |||
die "No write permission at $dir/PDL - not updating docs database .\n"; | die "No write permission at $dir/PDL - not updating docs database .\n"; | |||
} | } | |||
print "Found docs database $file\n"; | print "Found docs database $file\n"; | |||
$pdldoc = new ("PDL::Doc",($file)); | $pdldoc = PDL::Doc->new($file); | |||
last DIRECTORY; | last DIRECTORY; | |||
} | } | |||
} | } | |||
die "Unable to find docs database - therefore not updating it.\n" unless($pd ldoc); | die "Unable to find docs database - therefore not updating it.\n" unless($pd ldoc); | |||
my $mfile = $module; | my $mfile = $module; | |||
$mfile =~ s/\:\:/\//g; | $mfile =~ s/\:\:/\//g; | |||
for(@INC){ | for(@INC){ | |||
my $postfix; | my $postfix; | |||
skipping to change at line 884 | skipping to change at line 878 | |||
print "PDL docs database updated - added $f.\n"; | print "PDL docs database updated - added $f.\n"; | |||
$hit = 1; | $hit = 1; | |||
} | } | |||
} | } | |||
return if($hit); | return if($hit); | |||
} | } | |||
die "Unable to find a .pm or .pod file in \@INC for module $module\n"; | die "Unable to find a .pm or .pod file in \@INC for module $module\n"; | |||
} | } | |||
1; | ||||
=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 ($dir,$file,$pdldoc); | |||
DIRECTORY: for $dir (@INC) { | DIRECTORY: for $dir (@INC) { | |||
$file = $dir."/PDL/pdldoc.db"; | $file = $dir."/PDL/pdldoc.db"; | |||
skipping to change at line 942 | skipping to change at line 934 | |||
# Unpack the entry | # Unpack the entry | |||
print "---$key---\n$sym_hash->{$key}\n"; | print "---$key---\n$sym_hash->{$key}\n"; | |||
} | } | |||
=head2 Finding Modules | =head2 Finding Modules | |||
How can you tell if you've gotten a module for one of your entries? | How can you tell if you've gotten a module for one of your entries? | |||
The Ref entry will begin with 'Module:' if it's a module. In code: | The Ref entry will begin with 'Module:' if it's a module. In code: | |||
# Prints: | # Prints: | |||
# Module: fundamental PDL functionality and vectorization/threading | # Module: fundamental PDL functionality and vectorization/broadcasting | |||
print $pdldoc->gethash->{'PDL::Core'}->{'PDL::Core'}->{Ref}, "\n" | print $pdldoc->gethash->{'PDL::Core'}->{'PDL::Core'}->{Ref}, "\n" | |||
=head1 BUGS | =head1 BUGS | |||
Quite a few shortcomings which will hopefully be fixed following | Quite a few shortcomings which will hopefully be fixed following | |||
discussions on the pdl-devel mailing list. | discussions on the pdl-devel mailing list. | |||
=head1 AUTHOR | =head1 AUTHOR | |||
Copyright 1997 Christian Soeller E<lt>c.soeller@auckland.ac.nzE<gt> | Copyright 1997 Christian Soeller E<lt>c.soeller@auckland.ac.nzE<gt> | |||
End of changes. 19 change blocks. | ||||
22 lines changed or deleted | 14 lines changed or added |