Mercurial > forge
diff cvs-tree @ 0:6b33357c7561 octave-forge
Initial revision
author | pkienzle |
---|---|
date | Wed, 10 Oct 2001 19:54:49 +0000 |
parents | |
children | 9f3dfbc2d0a3 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cvs-tree Wed Oct 10 19:54:49 2001 +0000 @@ -0,0 +1,222 @@ +#!/usr/local/bin/perl + +use strict; + +# Set environment variables so I can update the cvs tree +$ENV{CVS_RSH} = 'ssh'; + +# If you're not cgijobs, you need to change the next line +$ENV{CVSROOT} = 'cgijobs@cvs.octave.sourceforge.net:/cvsroot/octave'; + +# variables used in this file +my ( + $basedir, + $maxiter, + $extensions, + $DMZ, + @directories, + $maxvar, + $temp, # all-purpose temporary variable + $directory, + @entries, + $entry, + $full, + $file, + %files +); + +print STDERR "Don't forget to do a cvs update before executing this...\n\n"; + +# ------------------------------------------------------------------ +# Walk the octave directories to find all .m files +# Parts of this code inspired from the +# Xavatoria Indexed Search, Index Building Module +# http://www.xav.com/scripts/xavatoria/ +# ------------------------------------------------------------------ + + +# where to start the search +$basedir = './'; + +# maximum number of iterations to avoid runaway process +$maxiter = 10000; + +#$extensions = "\.html\.htm\.shtml\.stm\.ztml\.shtml\."; +$extensions = '.m.'; + +# Below are the files or directories that you do NOT want to be +# searched. Note that they all have one blank space after the +# file or directory, and that directories do not include trailing +# slashes. Also note that we use the ".=" instead of the "=". + +$DMZ = './dld '; +#$DMZ .= "/usr/www/users/ifunds/cgi-bin "; + +unless (-e $basedir) { + print STDERR "Fatal Error!\n"; + print STDERR "Searched for a directory at specified location:\n"; + print STDERR " $basedir\n"; + print STDERR "No directory found. Check settings.\n"; + exit; +} + +@directories = ($basedir); +$maxvar = 1; +for ($temp=0;$temp<$maxiter;$temp++) { + $directory = @directories[$temp]; + last unless $directory =~ /[\w\.]/; # exit when we run out... + next if ($DMZ =~ /$directory /i); + next if $directory =~ /CVS\s*$/; # ignore CVS directories + opendir(DIR,$directory); + @entries = readdir(DIR); + closedir(DIR); + foreach $entry (@entries) { + next if (($entry eq ".") || ($entry eq "..")); + $full = "$directory/$entry"; + next if ($DMZ =~ /$full /i); + if (-d $full) { + push(@directories,$full); + $maxvar++; + } + elsif ((-T "$directory/$entry") && ($entry =~ /(.*)\.(.*)/)) { + if ($extensions =~ /\.$2\./) { # we found an .m file + # store filenames in a hash with the filename as the key + # and the directory (comma separated if more than one unique) + # as the value + if( $files{$entry}) { + $files{$entry} .= ",$directory"; + } + else { + $files{$entry} = $directory; + } + } + } + } +} + +# Output the page: +# FIXME: Does not handle multiple unique names (in separate directories)... + +print '<html><head><title>Octave Repository Function List</title></head>'; +print "\n<body>\n", titlebar(), hline(), '<p>'; + +print 'Unique file names: ', scalar keys %files, "\n<p>\n"; + +# first, print the summary +foreach $file (sort keys %files) { + $temp = func_name( $files{$file}, $file); + print qq[<a href="#$temp">$temp</a> - ]; +} + +# now, print each entry +print hline(); +foreach $file (sort keys %files) { + + $temp = func_name( $files{$file}, $file); + print qq[<p><a name="$temp">$temp</a>]; + + $temp = cvs_download_link( $files{$file}, $file); + print qq+ [<a href="$temp">Download</a>]+; + + print '<br><pre>' . func_descript( $files{$file}, $file) . "</pre>\n"; +} + +print "\n</body></html>\n"; + +exit; # all done + + +################################################################################ +# +# SUBROUTINES +# +################################################################################ + +# given the directory and file name, returns the name of the function defined +# by that file +sub func_name { + my ($_dir, $_file) = @_; + + $_file =~ /([^.]*)/; + return $1; +} + +sub hline { + return "\n<hr size=1 noshade>\n"; +} + +sub titlebar { + return qq~ + <A href="http://octave.sourceforge.net">Home</A> | + <A href="http://sourceforge.net/projects/octave/">Summary</A> | + <A href="http://sourceforge.net/forum/?group_id=2888">Forums</A> | + <A href="http://sourceforge.net/bugs/?group_id=2888">Bugs</A> | + <A href="http://sourceforge.net/support/?group_id=2888">Support</A> | + <A href="http://sourceforge.net/patch/?group_id=2888">Patches</A> | + <A href="http://sourceforge.net/mail/?group_id=2888">Lists</A> | + <A href="http://sourceforge.net/pm/?group_id=2888">Tasks</A> | + <A href="http://sourceforge.net/docman/?group_id=2888">Docs</A> | + <A href="http://sourceforge.net/survey/?group_id=2888">Surveys</A> | + <A href="http://sourceforge.net/news/?group_id=2888">News</A> | + <A href="http://sourceforge.net/cvs/?group_id=2888">CVS</A> | + <A href="http://sourceforge.net/project/filelist.php?group_id=2888">Files</A> + ~; +} + +# returns the URL to download a file +sub cvs_download_link { + my ($_dir, $_file) = @_; + + $_dir =~ s/^[.\/]*//; # get rid of the leading garbage + + return 'http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/octave/octave/' . + $_dir . '/' . $_file . '?rev=HEAD&content-type=text/plain'; +} + +sub func_descript { + my ($_dir, $_file) = @_; + my $retval = ''; + + if( open( IN, "$_dir/$_file")) { + # skip leading blank lines + while (<IN>) { + last if /\S/; + } + if( m/\s*#[\s#]* Copyright/) { + # next block is copyright statement, skip it + while (<IN>) { + last unless /^\s*#/; + } + } + # Skip any blank lines here + while ( /^\s*$/) { + $_ = <IN>; + last if not defined $_; + } + # At this point we should either have a function statement or + # the start of the description + if( m/^\s*#/) { + # Comment is starting, grab the first line unless its the texinfo thing + s/^[\s#]*//; + $retval .= $_ unless m/\-\*\-\s*texinfo\s*\-\*\-/; + } + else { + return unless m/function/i; + } + # Print out the rest of the documentation block + while (<IN>) { + last unless /^\s*#/; + s/^[\s#]*//; + # make texinfo substitutions + next if m/\-\*\-\s*texinfo\s*\-\*\-/; + s/\@var{([^}]*)}/<i>\1<\/i>/g; # This must go before deftypefnx substitution + s/\@deftypefnx*\s*{[^}]*}\s*{([^}]*)}\s*/\1/g; + s/\@end\s*deftypefn//g; + $retval .= $_; + } + return $retval; + } + else { + print STDERR "Could not open file ($_dir/$_file): $!\n"; + } +}