Mercurial > forge

view cvs-tree @ 0:6b33357c7561 octave-forge

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial revision
author pkienzle
date Wed, 10 Oct 2001 19:54:49 +0000
parents
children 9f3dfbc2d0a3
line wrap: on
line source

#!/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>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/projects/octave/">Summary</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/forum/?group_id=2888">Forums</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/bugs/?group_id=2888">Bugs</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/support/?group_id=2888">Support</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/patch/?group_id=2888">Patches</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/mail/?group_id=2888">Lists</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/pm/?group_id=2888">Tasks</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/docman/?group_id=2888">Docs</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/survey/?group_id=2888">Surveys</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/news/?group_id=2888">News</A>&nbsp;|&nbsp;
	<A href="http://sourceforge.net/cvs/?group_id=2888">CVS</A>&nbsp;|&nbsp;
	<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";
	}
}