René Nyffenegger's collection of things on the web
René Nyffenegger on Oracle - Most wanted - Feedback -
 

Creating A PL SQL Tag File

Thanks a lot to Dany Dayan who sent me this perl script that creates a Tag File for PL/SQL!
#! /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));