#! /usr/bin/perl -w
#
# Copyright (C) 2002 Dany Dayan
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of either:
#
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 1, or (at your option) any
# later version, or
#
# b) the "Artistic License"
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
# the GNU General Public License or the Artistic License for more details.
use strict;
die "Usage: $0 <file> [file ...]\n" if ($#ARGV < 0);
my $file = $ARGV[0];
my @output;
my $in_proc = 0;
my $in_type = 0;
my $in_comment = 0;
my $content;
my $entry;
my $tag;
while (defined (my $line = <>))
{
chop $line; # Remove LF
chop $line if ($line =~ /\r$/); # Allow for CRLF terminations
# Are we in a comment and is there a comment end?
if (($in_comment) && ($line =~ /\*\/(.*)$/))
{
$content = $1;
$in_comment = 0;
}
else
{
$content = $line;
}
# Are we still in a comment?
next if ($in_comment);
# Remove all single line comments
$content =~ s/\*\/\*.*?\*\///g;
$content =~ s/--.*$//;
# Is there a comment start?
if ($content =~ /^(.*?)\/\*/)
{
$content = $1;
$in_comment = 1;
}
# Are we in a new comment;
next if ($in_comment);
if (!$in_proc)
{
if ($content =~ /\b(?i:(?:function|procedure))\s/)
{
$in_proc = 1;
$tag = $line;
$entry = '';
# print "$line\n";
}
elsif ($content =~ /^\s*(?i:(?:sub)?type)\b/)
{
$in_type = 1;
$tag = $line;
$entry = '';
}
elsif ($content =~ /^\s*([^\s]+)\s+(?i:constant)\b/)
{
push (@output, "$1\t$file\t?^$line\$?");
next;
}
}
if ($in_proc)
{
$entry .= "$content\n";
if ($entry =~ /\b(?i:(?:is|as))\b/)
{
if ($entry =~ /\b(?i:(?:function|procedure))\s+([^\s]+)/)
{
push (@output, "$1\t$file\t?^$tag\$?");
#print "$1\t$file\t?^$tag\$?\n";
}
else
{
print STDERR "Could not find name in $entry\n";
}
$in_proc = 0;
}
elsif ($entry =~ /;/)
{
$in_proc = 0;
}
}
elsif ($in_type)
{
$entry .= "$content\n";
if ($entry =~ /^\s*(?i:(?:sub)?type)\s+([^\s]+)/)
{
push (@output, "$1\t$file\t?^$tag\$?");
$in_type = 0;
}
elsif ($entry =~ /;/)
{
print STDERR "Could not find name in $entry\n";
$in_type = 0;
}
}
$file = $ARGV[0] if (eof);
}
print join ("\n", sort (@output));