|
0
|
1 #!/usr/local/bin/perl |
|
|
2 |
|
|
3 use strict; |
|
|
4 |
|
|
5 # Set environment variables so I can update the cvs tree |
|
|
6 $ENV{CVS_RSH} = 'ssh'; |
|
|
7 |
|
|
8 # If you're not cgijobs, you need to change the next line |
|
|
9 $ENV{CVSROOT} = 'cgijobs@cvs.octave.sourceforge.net:/cvsroot/octave'; |
|
|
10 |
|
|
11 # variables used in this file |
|
|
12 my ( |
|
|
13 $basedir, |
|
|
14 $maxiter, |
|
|
15 $extensions, |
|
|
16 $DMZ, |
|
|
17 @directories, |
|
|
18 $maxvar, |
|
|
19 $temp, # all-purpose temporary variable |
|
|
20 $directory, |
|
|
21 @entries, |
|
|
22 $entry, |
|
|
23 $full, |
|
|
24 $file, |
|
|
25 %files |
|
|
26 ); |
|
|
27 |
|
|
28 print STDERR "Don't forget to do a cvs update before executing this...\n\n"; |
|
|
29 |
|
|
30 # ------------------------------------------------------------------ |
|
|
31 # Walk the octave directories to find all .m files |
|
|
32 # Parts of this code inspired from the |
|
|
33 # Xavatoria Indexed Search, Index Building Module |
|
|
34 # http://www.xav.com/scripts/xavatoria/ |
|
|
35 # ------------------------------------------------------------------ |
|
|
36 |
|
|
37 |
|
|
38 # where to start the search |
|
|
39 $basedir = './'; |
|
|
40 |
|
|
41 # maximum number of iterations to avoid runaway process |
|
|
42 $maxiter = 10000; |
|
|
43 |
|
|
44 #$extensions = "\.html\.htm\.shtml\.stm\.ztml\.shtml\."; |
|
|
45 $extensions = '.m.'; |
|
|
46 |
|
|
47 # Below are the files or directories that you do NOT want to be |
|
|
48 # searched. Note that they all have one blank space after the |
|
|
49 # file or directory, and that directories do not include trailing |
|
|
50 # slashes. Also note that we use the ".=" instead of the "=". |
|
|
51 |
|
|
52 $DMZ = './dld '; |
|
|
53 #$DMZ .= "/usr/www/users/ifunds/cgi-bin "; |
|
|
54 |
|
|
55 unless (-e $basedir) { |
|
|
56 print STDERR "Fatal Error!\n"; |
|
|
57 print STDERR "Searched for a directory at specified location:\n"; |
|
|
58 print STDERR " $basedir\n"; |
|
|
59 print STDERR "No directory found. Check settings.\n"; |
|
|
60 exit; |
|
|
61 } |
|
|
62 |
|
|
63 @directories = ($basedir); |
|
|
64 $maxvar = 1; |
|
|
65 for ($temp=0;$temp<$maxiter;$temp++) { |
|
|
66 $directory = @directories[$temp]; |
|
|
67 last unless $directory =~ /[\w\.]/; # exit when we run out... |
|
|
68 next if ($DMZ =~ /$directory /i); |
|
|
69 next if $directory =~ /CVS\s*$/; # ignore CVS directories |
|
|
70 opendir(DIR,$directory); |
|
|
71 @entries = readdir(DIR); |
|
|
72 closedir(DIR); |
|
|
73 foreach $entry (@entries) { |
|
|
74 next if (($entry eq ".") || ($entry eq "..")); |
|
|
75 $full = "$directory/$entry"; |
|
|
76 next if ($DMZ =~ /$full /i); |
|
|
77 if (-d $full) { |
|
|
78 push(@directories,$full); |
|
|
79 $maxvar++; |
|
|
80 } |
|
|
81 elsif ((-T "$directory/$entry") && ($entry =~ /(.*)\.(.*)/)) { |
|
|
82 if ($extensions =~ /\.$2\./) { # we found an .m file |
|
|
83 # store filenames in a hash with the filename as the key |
|
|
84 # and the directory (comma separated if more than one unique) |
|
|
85 # as the value |
|
|
86 if( $files{$entry}) { |
|
|
87 $files{$entry} .= ",$directory"; |
|
|
88 } |
|
|
89 else { |
|
|
90 $files{$entry} = $directory; |
|
|
91 } |
|
|
92 } |
|
|
93 } |
|
|
94 } |
|
|
95 } |
|
|
96 |
|
|
97 # Output the page: |
|
|
98 # FIXME: Does not handle multiple unique names (in separate directories)... |
|
|
99 |
|
|
100 print '<html><head><title>Octave Repository Function List</title></head>'; |
|
|
101 print "\n<body>\n", titlebar(), hline(), '<p>'; |
|
|
102 |
|
|
103 print 'Unique file names: ', scalar keys %files, "\n<p>\n"; |
|
|
104 |
|
|
105 # first, print the summary |
|
|
106 foreach $file (sort keys %files) { |
|
|
107 $temp = func_name( $files{$file}, $file); |
|
|
108 print qq[<a href="#$temp">$temp</a> - ]; |
|
|
109 } |
|
|
110 |
|
|
111 # now, print each entry |
|
|
112 print hline(); |
|
|
113 foreach $file (sort keys %files) { |
|
|
114 |
|
|
115 $temp = func_name( $files{$file}, $file); |
|
|
116 print qq[<p><a name="$temp">$temp</a>]; |
|
|
117 |
|
|
118 $temp = cvs_download_link( $files{$file}, $file); |
|
|
119 print qq+ [<a href="$temp">Download</a>]+; |
|
|
120 |
|
|
121 print '<br><pre>' . func_descript( $files{$file}, $file) . "</pre>\n"; |
|
|
122 } |
|
|
123 |
|
|
124 print "\n</body></html>\n"; |
|
|
125 |
|
|
126 exit; # all done |
|
|
127 |
|
|
128 |
|
|
129 ################################################################################ |
|
|
130 # |
|
|
131 # SUBROUTINES |
|
|
132 # |
|
|
133 ################################################################################ |
|
|
134 |
|
|
135 # given the directory and file name, returns the name of the function defined |
|
|
136 # by that file |
|
|
137 sub func_name { |
|
|
138 my ($_dir, $_file) = @_; |
|
|
139 |
|
|
140 $_file =~ /([^.]*)/; |
|
|
141 return $1; |
|
|
142 } |
|
|
143 |
|
|
144 sub hline { |
|
|
145 return "\n<hr size=1 noshade>\n"; |
|
|
146 } |
|
|
147 |
|
|
148 sub titlebar { |
|
|
149 return qq~ |
|
|
150 <A href="http://octave.sourceforge.net">Home</A> | |
|
|
151 <A href="http://sourceforge.net/projects/octave/">Summary</A> | |
|
|
152 <A href="http://sourceforge.net/forum/?group_id=2888">Forums</A> | |
|
|
153 <A href="http://sourceforge.net/bugs/?group_id=2888">Bugs</A> | |
|
|
154 <A href="http://sourceforge.net/support/?group_id=2888">Support</A> | |
|
|
155 <A href="http://sourceforge.net/patch/?group_id=2888">Patches</A> | |
|
|
156 <A href="http://sourceforge.net/mail/?group_id=2888">Lists</A> | |
|
|
157 <A href="http://sourceforge.net/pm/?group_id=2888">Tasks</A> | |
|
|
158 <A href="http://sourceforge.net/docman/?group_id=2888">Docs</A> | |
|
|
159 <A href="http://sourceforge.net/survey/?group_id=2888">Surveys</A> | |
|
|
160 <A href="http://sourceforge.net/news/?group_id=2888">News</A> | |
|
|
161 <A href="http://sourceforge.net/cvs/?group_id=2888">CVS</A> | |
|
|
162 <A href="http://sourceforge.net/project/filelist.php?group_id=2888">Files</A> |
|
|
163 ~; |
|
|
164 } |
|
|
165 |
|
|
166 # returns the URL to download a file |
|
|
167 sub cvs_download_link { |
|
|
168 my ($_dir, $_file) = @_; |
|
|
169 |
|
|
170 $_dir =~ s/^[.\/]*//; # get rid of the leading garbage |
|
|
171 |
|
|
172 return 'http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/octave/octave/' . |
|
|
173 $_dir . '/' . $_file . '?rev=HEAD&content-type=text/plain'; |
|
|
174 } |
|
|
175 |
|
|
176 sub func_descript { |
|
|
177 my ($_dir, $_file) = @_; |
|
|
178 my $retval = ''; |
|
|
179 |
|
|
180 if( open( IN, "$_dir/$_file")) { |
|
|
181 # skip leading blank lines |
|
|
182 while (<IN>) { |
|
|
183 last if /\S/; |
|
|
184 } |
|
|
185 if( m/\s*#[\s#]* Copyright/) { |
|
|
186 # next block is copyright statement, skip it |
|
|
187 while (<IN>) { |
|
|
188 last unless /^\s*#/; |
|
|
189 } |
|
|
190 } |
|
|
191 # Skip any blank lines here |
|
|
192 while ( /^\s*$/) { |
|
|
193 $_ = <IN>; |
|
|
194 last if not defined $_; |
|
|
195 } |
|
|
196 # At this point we should either have a function statement or |
|
|
197 # the start of the description |
|
|
198 if( m/^\s*#/) { |
|
|
199 # Comment is starting, grab the first line unless its the texinfo thing |
|
|
200 s/^[\s#]*//; |
|
|
201 $retval .= $_ unless m/\-\*\-\s*texinfo\s*\-\*\-/; |
|
|
202 } |
|
|
203 else { |
|
|
204 return unless m/function/i; |
|
|
205 } |
|
|
206 # Print out the rest of the documentation block |
|
|
207 while (<IN>) { |
|
|
208 last unless /^\s*#/; |
|
|
209 s/^[\s#]*//; |
|
|
210 # make texinfo substitutions |
|
|
211 next if m/\-\*\-\s*texinfo\s*\-\*\-/; |
|
|
212 s/\@var{([^}]*)}/<i>\1<\/i>/g; # This must go before deftypefnx substitution |
|
|
213 s/\@deftypefnx*\s*{[^}]*}\s*{([^}]*)}\s*/\1/g; |
|
|
214 s/\@end\s*deftypefn//g; |
|
|
215 $retval .= $_; |
|
|
216 } |
|
|
217 return $retval; |
|
|
218 } |
|
|
219 else { |
|
|
220 print STDERR "Could not open file ($_dir/$_file): $!\n"; |
|
|
221 } |
|
|
222 } |
