forked from PDLPorters/pdl
-
Notifications
You must be signed in to change notification settings - Fork 0
/
pdldoc.PL
221 lines (146 loc) · 4.46 KB
/
pdldoc.PL
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
use strict;
use Config;
use File::Basename qw(&basename &dirname);
use IO::File;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries. Thus you write
# $startperl
# to ensure Configure will look for $Config{startperl}.
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
chdir(dirname($0));
my $file;
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
unlink $file if -f $file;
my $fh = new IO::File "> $file" or die "Can't create $file: $!";
# check for bad value support
use vars qw( $bvalflag );
use File::Spec;
require File::Spec->catfile( "Basic", "Core", "badsupport.p" );
my $usage_info;
if ( $bvalflag ) {
print "Extracting $file (WITH bad value support)\n";
$usage_info = "[-a] [-b] [-h] [-s] [-u] <string>";
} else {
print "Extracting $file (NO bad value support)\n";
$usage_info = "[-a] [-h] [-s] [-u] <string>";
}
# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.
print $fh <<"!GROK!THIS!";
$Config{'startperl'}
eval 'exec perl -S \$0 "\$@"'
if 0;
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print $fh <<'!NO!SUBS!';
use strict;
$|++;
use PDL::Config;
BEGIN {
if ( not $PDL::Config{PDLDOC_IGNORE_AUTOLOADER} ) {
require PDL::AutoLoader;
}
}
use PDL::Doc::Perldl;
use File::Basename;
use vars qw( $VERSION );
$VERSION = '0.3';
my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
my %options =
( a => \&apropos,
!NO!SUBS!
print $fh ' b => \&badinfo,' . "\n" if $bvalflag;
print $fh <<'!NO!SUBS!';
h => \&help, s => \&sig, u => \&usage );
my $name = basename( $0 );
my $usage = <<"EOH";
!NO!SUBS!
print $fh "Usage: \$name $usage_info\n";
print $fh <<'!NO!SUBS!';
This program provides command-line access to the PDL documentation.
If no flag is specified, -h is assumed.
-a (apropos) searches the documentation for the string
!NO!SUBS!
print $fh " -b (badinfo) does the function support bad values?\n"
if $bvalflag;
print $fh <<'!NO!SUBS!';
-h (help) prints the help for the function/module/document
-s (sig) prints the signature of the function
-u (usage) gives usage information on the function
EOH
my $oflag = $#ARGV > -1 ? substr($ARGV[0],0,1) eq "-" : 0;
die $usage unless ($#ARGV == 0 and not $oflag) or ($#ARGV == 1 and $oflag);
my $option = "h";
if ( $oflag ) {
$option = substr($ARGV[0],1,1);
die $usage unless exists $options{$option};
shift @ARGV;
}
&{$options{$option}}( $ARGV[0] );
exit;
__END__
=head1 NAME
pdldoc - shell interface to PDL documentation
=head1 SYNOPSIS
B<pdldoc> <text>
=cut
!NO!SUBS!
if ( $bvalflag ) {
print $fh <<'!NO!SUBS!';
B<pdldoc> [B<-a>] [B<-b>] [B<-h>] [B<-s>] [B<-u>] <text>
!NO!SUBS!
} else {
print $fh <<'!NO!SUBS!';
B<pdldoc> [B<-a>] [B<-h>] [B<-s>] [B<-u>] <text>
!NO!SUBS!
}
print $fh <<'!NO!SUBS!';
=head1 DESCRIPTION
The aim of B<pdldoc> is to provide the same functionality
as the C<apropos>, C<help>, C<sig>,
=cut
!NO!SUBS!
print $fh "C<badinfo>, \n" if $bvalflag;
print $fh <<'!NO!SUBS!';
and C<usage> commands available in the L<perldl|PDL::perldl>
and L<pdl2|pdl2> shells.
Think of it as the PDL equivalent of C<perldoc -f>.
=head1 OPTIONS
=over 5
=item B<-h> help
print documentation about a PDL function or module or show a PDL manual.
This is the default option.
=item B<-a> apropos
Regex search PDL documentation database.
=cut
!NO!SUBS!
print $fh <<'!NO!SUBS!' if $bvalflag;
=item B<-b> badinfo
Information on the support for bad values provided by the function.
=cut
!NO!SUBS!
print $fh <<'!NO!SUBS!';
=item B<-s> sig
prints signature of PDL function.
=item B<-u> usage
Prints usage information for a PDL function.
=item C<$PDL::Config{PDLDOC_IGNORE_AUTOLOADER}>
This PDL configuration variable may be set in the perldl.conf
file to disable runtime search for documentation in
L<PDL::AutoLoader|PDL::AutoLoader> files.
=back
=head1 VERSION
This is pdldoc version 0.3.
=head1 AUTHOR
Doug Burke <burke at ifa dot hawaii dot edu>.
Chris Marshall <chm at cpan dot org>.
=cut
!NO!SUBS!
$fh->close;
chmod 0555, $file;
# end