ddnet/docs/tool/Modules/NaturalDocs/Languages/PLSQL.pm
2008-08-02 08:21:29 +00:00

320 lines
9.3 KiB
Perl

###############################################################################
#
# Class: NaturalDocs::Languages::PLSQL
#
###############################################################################
#
# A subclass to handle the language variations of PL/SQL.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright (C) 2003-2008 Greg Valure
# Natural Docs is licensed under the GPL
use strict;
use integer;
package NaturalDocs::Languages::PLSQL;
use base 'NaturalDocs::Languages::Simple';
#
# Function: OnPrototypeEnd
#
# Microsoft's SQL specifies parameters as shown below.
#
# > CREATE PROCEDURE Test @as int, @foo int AS ...
#
# Having a parameter @is or @as is perfectly valid even though those words are also used to end the prototype. We need to
# ignore text-based enders preceded by an at sign. Also note that it does not have parenthesis for parameter lists. We need to
# skip all commas if the prototype doesn't have parenthesis but does have @ characters.
#
# Identifiers such as function names may contain the characters $, #, and _, so if "as" or "is" appears directly after one of them
# we need to ignore the ender there as well.
#
# > FUNCTION Something_is_something ...
#
# Parameters:
#
# type - The <TopicType> of the prototype.
# prototypeRef - A reference to the prototype so far, minus the ender in dispute.
# ender - The ender symbol.
#
# Returns:
#
# ENDER_ACCEPT - The ender is accepted and the prototype is finished.
# ENDER_IGNORE - The ender is rejected and parsing should continue. Note that the prototype will be rejected as a whole
# if all enders are ignored before reaching the end of the code.
# ENDER_ACCEPT_AND_CONTINUE - The ender is accepted so the prototype may stand as is. However, the prototype might
# also continue on so continue parsing. If there is no accepted ender between here and
# the end of the code this version will be accepted instead.
# ENDER_REVERT_TO_ACCEPTED - The expedition from ENDER_ACCEPT_AND_CONTINUE failed. Use the last accepted
# version and end parsing.
#
sub OnPrototypeEnd #(type, prototypeRef, ender)
{
my ($self, $type, $prototypeRef, $ender) = @_;
# _ should be handled already.
if ($ender =~ /^[a-z]+$/i && substr($$prototypeRef, -1) =~ /^[\@\$\#]$/)
{ return ::ENDER_IGNORE(); }
elsif ($type eq ::TOPIC_FUNCTION() && $ender eq ',')
{
if ($$prototypeRef =~ /^[^\(]*\@/)
{ return ::ENDER_IGNORE(); }
else
{ return ::ENDER_ACCEPT(); };
}
else
{ return ::ENDER_ACCEPT(); };
};
#
# Function: ParsePrototype
#
# Overridden to handle Microsoft's parenthesisless version. Otherwise just throws to the parent.
#
# Parameters:
#
# type - The <TopicType>.
# prototype - The text prototype.
#
# Returns:
#
# A <NaturalDocs::Languages::Prototype> object.
#
sub ParsePrototype #(type, prototype)
{
my ($self, $type, $prototype) = @_;
my $noParenthesisParameters = ($type eq ::TOPIC_FUNCTION() && $prototype =~ /^[^\(]*\@/);
if ($prototype !~ /\(.*[^ ].*\)/ && !$noParenthesisParameters)
{ return $self->SUPER::ParsePrototype($type, $prototype); };
my ($beforeParameters, $afterParameters, $isAfterParameters);
if ($noParenthesisParameters)
{
($beforeParameters, $prototype) = split(/\@/, $prototype, 2);
$prototype = '@' . $prototype;
};
my @tokens = $prototype =~ /([^\(\)\[\]\{\}\<\>\'\"\,]+|.)/g;
my $parameter;
my @parameterLines;
my @symbolStack;
foreach my $token (@tokens)
{
if ($isAfterParameters)
{ $afterParameters .= $token; }
elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
{
if ($noParenthesisParameters || $symbolStack[0] eq '(')
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
if ($token eq $symbolStack[-1])
{ pop @symbolStack; };
}
elsif ($token =~ /^[\(\[\{\<\'\"]$/)
{
if ($noParenthesisParameters || $symbolStack[0] eq '(')
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
push @symbolStack, $token;
}
elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
($token eq ']' && $symbolStack[-1] eq '[') ||
($token eq '}' && $symbolStack[-1] eq '{') ||
($token eq '>' && $symbolStack[-1] eq '<') )
{
if (!$noParenthesisParameters && $token eq ')' && scalar @symbolStack == 1 && $symbolStack[0] eq '(')
{
$afterParameters .= $token;
$isAfterParameters = 1;
}
else
{ $parameter .= $token; };
pop @symbolStack;
}
elsif ($token eq ',')
{
if (!scalar @symbolStack)
{
if ($noParenthesisParameters)
{
push @parameterLines, $parameter . $token;
$parameter = undef;
}
else
{
$beforeParameters .= $token;
};
}
else
{
if (scalar @symbolStack == 1 && $symbolStack[0] eq '(' && !$noParenthesisParameters)
{
push @parameterLines, $parameter . $token;
$parameter = undef;
}
else
{
$parameter .= $token;
};
};
}
else
{
if ($noParenthesisParameters || $symbolStack[0] eq '(')
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
};
};
push @parameterLines, $parameter;
foreach my $item (\$beforeParameters, \$afterParameters)
{
$$item =~ s/^ //;
$$item =~ s/ $//;
}
my $prototypeObject = NaturalDocs::Languages::Prototype->New($beforeParameters, $afterParameters);
# Parse the actual parameters.
foreach my $parameterLine (@parameterLines)
{
$prototypeObject->AddParameter( $self->ParseParameterLine($parameterLine) );
};
return $prototypeObject;
};
#
# Function: ParseParameterLine
#
# Parses a prototype parameter line and returns it as a <NaturalDocs::Languages::Prototype::Parameter> object.
#
sub ParseParameterLine #(line)
{
my ($self, $line) = @_;
$line =~ s/^ //;
$line =~ s/ $//;
my @tokens = $line =~ /([^\(\)\[\]\{\}\<\>\'\"\:\=\ ]+|\:\=|.)/g;
my ($name, $type, $defaultValue, $defaultValuePrefix, $inType, $inDefaultValue);
my @symbolStack;
foreach my $token (@tokens)
{
if ($inDefaultValue)
{ $defaultValue .= $token; }
elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
{
if ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
if ($token eq $symbolStack[-1])
{ pop @symbolStack; };
}
elsif ($token =~ /^[\(\[\{\<\'\"]$/)
{
if ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
push @symbolStack, $token;
}
elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
($token eq ']' && $symbolStack[-1] eq '[') ||
($token eq '}' && $symbolStack[-1] eq '{') ||
($token eq '>' && $symbolStack[-1] eq '<') )
{
if ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
pop @symbolStack;
}
elsif ($token eq ' ')
{
if ($inType)
{ $type .= $token; }
elsif (!scalar @symbolStack)
{ $inType = 1; }
else
{ $name .= $token; };
}
elsif ($token eq ':=' || $token eq '=')
{
if (!scalar @symbolStack)
{
$defaultValuePrefix = $token;
$inDefaultValue = 1;
}
elsif ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
}
else
{
if ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
};
};
foreach my $part (\$type, \$defaultValue)
{
$$part =~ s/ $//;
};
return NaturalDocs::Languages::Prototype::Parameter->New($type, undef, $name, undef, $defaultValue, $defaultValuePrefix);
};
sub TypeBeforeParameter
{ return 0; };
1;