<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">###############################################################################
#
#   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.
#
#   &gt; 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.
#
#	&gt; FUNCTION Something_is_something ...
#
#   Parameters:
#
#       type - The &lt;TopicType&gt; 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 &amp;&amp; substr($$prototypeRef, -1) =~ /^[\@\$\#]$/)
        {  return ::ENDER_IGNORE();  }

    elsif ($type eq ::TOPIC_FUNCTION() &amp;&amp; $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 &lt;TopicType&gt;.
#       prototype - The text prototype.
#
#   Returns:
#
#       A &lt;NaturalDocs::Languages::Prototype&gt; object.
#
sub ParsePrototype #(type, prototype)
    {
    my ($self, $type, $prototype) = @_;

    my $noParenthesisParameters = ($type eq ::TOPIC_FUNCTION() &amp;&amp; $prototype =~ /^[^\(]*\@/);

    if ($prototype !~ /\(.*[^ ].*\)/ &amp;&amp; !$noParenthesisParameters)
        {  return $self-&gt;SUPER::ParsePrototype($type, $prototype);  };



    my ($beforeParameters, $afterParameters, $isAfterParameters);

    if ($noParenthesisParameters)
        {
        ($beforeParameters, $prototype) = split(/\@/, $prototype, 2);
        $prototype = '@' . $prototype;
        };

    my @tokens = $prototype =~ /([^\(\)\[\]\{\}\&lt;\&gt;\'\"\,]+|.)/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 =~ /^[\(\[\{\&lt;\'\"]$/)
            {
            if ($noParenthesisParameters || $symbolStack[0] eq '(')
                {  $parameter .= $token;  }
            else
                {  $beforeParameters .= $token;  };

            push @symbolStack, $token;
            }

        elsif ( ($token eq ')' &amp;&amp; $symbolStack[-1] eq '(') ||
                 ($token eq ']' &amp;&amp; $symbolStack[-1] eq '[') ||
                 ($token eq '}' &amp;&amp; $symbolStack[-1] eq '{') ||
                 ($token eq '&gt;' &amp;&amp; $symbolStack[-1] eq '&lt;') )
            {
            if (!$noParenthesisParameters &amp;&amp; $token eq ')' &amp;&amp; scalar @symbolStack == 1 &amp;&amp; $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 &amp;&amp; $symbolStack[0] eq '(' &amp;&amp; !$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-&gt;New($beforeParameters, $afterParameters);


    # Parse the actual parameters.

    foreach my $parameterLine (@parameterLines)
        {
        $prototypeObject-&gt;AddParameter( $self-&gt;ParseParameterLine($parameterLine) );
        };

    return $prototypeObject;
    };


#
#   Function: ParseParameterLine
#
#   Parses a prototype parameter line and returns it as a &lt;NaturalDocs::Languages::Prototype::Parameter&gt; object.
#
sub ParseParameterLine #(line)
    {
    my ($self, $line) = @_;

    $line =~ s/^ //;
    $line =~ s/ $//;

    my @tokens = $line =~ /([^\(\)\[\]\{\}\&lt;\&gt;\'\"\:\=\ ]+|\:\=|.)/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 =~ /^[\(\[\{\&lt;\'\"]$/)
            {
            if ($inType)
                {  $type .= $token;  }
            else
                {  $name .= $token;  };

            push @symbolStack, $token;
            }

        elsif ( ($token eq ')' &amp;&amp; $symbolStack[-1] eq '(') ||
                 ($token eq ']' &amp;&amp; $symbolStack[-1] eq '[') ||
                 ($token eq '}' &amp;&amp; $symbolStack[-1] eq '{') ||
                 ($token eq '&gt;' &amp;&amp; $symbolStack[-1] eq '&lt;') )
            {
            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-&gt;New($type, undef, $name, undef, $defaultValue, $defaultValuePrefix);
    };


sub TypeBeforeParameter
    {  return 0;  };

1;
</pre></body></html>