GPL_bin_fullset/NaturalDocs/Modules/NaturalDocs/Languages/PLSQL.pm

   1 ###############################################################################
   2 #
   3 #   Class: NaturalDocs::Languages::PLSQL
   4 #
   5 ###############################################################################
   6 #
   7 #   A subclass to handle the language variations of PL/SQL.
   8 #
   9 ###############################################################################
  10
  11 # This file is part of Natural Docs, which is Copyright © 2003-2010 Greg Valure
  12 # Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
  13 # Refer to License.txt for the complete details
  14
  15 use strict;
  16 use integer;
  17
  18 package NaturalDocs::Languages::PLSQL;
  19
  20 use base 'NaturalDocs::Languages::Simple';
  21
  22
  23 #
  24 #   Function: OnPrototypeEnd
  25 #
  26 #   Microsoft's SQL specifies parameters as shown below.
  27 #
  28 #   > CREATE PROCEDURE Test @as int, @foo int AS ...
  29 #
  30 #   Having a parameter @is or @as is perfectly valid even though those words are also used to end the prototype.  We need to
  31 #   ignore text-based enders preceded by an at sign.  Also note that it does not have parenthesis for parameter lists.  We need to
  32 #   skip all commas if the prototype doesn't have parenthesis but does have @ characters.
  33 #
  34 #       Identifiers such as function names may contain the characters $, #, and _, so if "as" or "is" appears directly after one of them
  35 #       we need to ignore the ender there as well.
  36 #
  37 #       > FUNCTION Something_is_something ...
  38 #
  39 #   Parameters:
  40 #
  41 #       type - The <TopicType> of the prototype.
  42 #       prototypeRef - A reference to the prototype so far, minus the ender in dispute.
  43 #       ender - The ender symbol.
  44 #
  45 #   Returns:
  46 #
  47 #       ENDER_ACCEPT - The ender is accepted and the prototype is finished.
  48 #       ENDER_IGNORE - The ender is rejected and parsing should continue.  Note that the prototype will be rejected as a whole
  49 #                                  if all enders are ignored before reaching the end of the code.
  50 #       ENDER_ACCEPT_AND_CONTINUE - The ender is accepted so the prototype may stand as is.  However, the prototype might
  51 #                                                          also continue on so continue parsing.  If there is no accepted ender between here and
  52 #                                                          the end of the code this version will be accepted instead.
  53 #       ENDER_REVERT_TO_ACCEPTED - The expedition from ENDER_ACCEPT_AND_CONTINUE failed.  Use the last accepted
  54 #                                                        version and end parsing.
  55 #
  56 sub OnPrototypeEnd #(type, prototypeRef, ender)
  57     {
  58     my ($self, $type, $prototypeRef, $ender) = @_;
  59
  60     # _ should be handled already.
  61     if ($ender =~ /^[a-z]+$/i && substr($$prototypeRef, -1) =~ /^[\@\$\#]$/)
  62         {  return ::ENDER_IGNORE();  }
  63
  64     elsif ($type eq ::TOPIC_FUNCTION() && $ender eq ',')
  65         {
  66         if ($$prototypeRef =~ /^[^\(]*\@/)
  67             {  return ::ENDER_IGNORE();  }
  68         else
  69             {  return ::ENDER_ACCEPT();  };
  70         }
  71
  72     else
  73         {  return ::ENDER_ACCEPT();  };
  74     };
  75
  76
  77 #
  78 #   Function: ParsePrototype
  79 #
  80 #   Overridden to handle Microsoft's parenthesisless version.  Otherwise just throws to the parent.
  81 #
  82 #   Parameters:
  83 #
  84 #       type - The <TopicType>.
  85 #       prototype - The text prototype.
  86 #
  87 #   Returns:
  88 #
  89 #       A <NaturalDocs::Languages::Prototype> object.
  90 #
  91 sub ParsePrototype #(type, prototype)
  92     {
  93     my ($self, $type, $prototype) = @_;
  94
  95     my $noParenthesisParameters = ($type eq ::TOPIC_FUNCTION() && $prototype =~ /^[^\(]*\@/);
  96
  97     if ($prototype !~ /\(.*[^ ].*\)/ && !$noParenthesisParameters)
  98         {  return $self->SUPER::ParsePrototype($type, $prototype);  };
  99
 100
 101
 102     my ($beforeParameters, $afterParameters, $isAfterParameters);
 103
 104     if ($noParenthesisParameters)
 105         {
 106         ($beforeParameters, $prototype) = split(/\@/, $prototype, 2);
 107         $prototype = '@' . $prototype;
 108         };
 109
 110     my @tokens = $prototype =~ /([^\(\)\[\]\{\}\<\>\'\"\,]+|.)/g;
 111
 112     my $parameter;
 113     my @parameterLines;
 114
 115     my @symbolStack;
 116
 117     foreach my $token (@tokens)
 118         {
 119         if ($isAfterParameters)
 120             {  $afterParameters .= $token;  }
 121
 122         elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
 123             {
 124             if ($noParenthesisParameters || $symbolStack[0] eq '(')
 125                 {  $parameter .= $token;  }
 126             else
 127                 {  $beforeParameters .= $token;  };
 128
 129             if ($token eq $symbolStack[-1])
 130                 {  pop @symbolStack;  };
 131             }
 132
 133         elsif ($token =~ /^[\(\[\{\<\'\"]$/)
 134             {
 135             if ($noParenthesisParameters || $symbolStack[0] eq '(')
 136                 {  $parameter .= $token;  }
 137             else
 138                 {  $beforeParameters .= $token;  };
 139
 140             push @symbolStack, $token;
 141             }
 142
 143         elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
 144                  ($token eq ']' && $symbolStack[-1] eq '[') ||
 145                  ($token eq '}' && $symbolStack[-1] eq '{') ||
 146                  ($token eq '>' && $symbolStack[-1] eq '<') )
 147             {
 148             if (!$noParenthesisParameters && $token eq ')' && scalar @symbolStack == 1 && $symbolStack[0] eq '(')
 149                 {
 150                 $afterParameters .= $token;
 151                 $isAfterParameters = 1;
 152                 }
 153             else
 154                 {  $parameter .= $token;  };
 155
 156             pop @symbolStack;
 157             }
 158
 159         elsif ($token eq ',')
 160             {
 161             if (!scalar @symbolStack)
 162                 {
 163                 if ($noParenthesisParameters)
 164                     {
 165                     push @parameterLines, $parameter . $token;
 166                     $parameter = undef;
 167                     }
 168                 else
 169                     {
 170                     $beforeParameters .= $token;
 171                     };
 172                 }
 173             else
 174                 {
 175                 if (scalar @symbolStack == 1 && $symbolStack[0] eq '(' && !$noParenthesisParameters)
 176                     {
 177                     push @parameterLines, $parameter . $token;
 178                     $parameter = undef;
 179                     }
 180                 else
 181                     {
 182                     $parameter .= $token;
 183                     };
 184                 };
 185             }
 186
 187         else
 188             {
 189             if ($noParenthesisParameters || $symbolStack[0] eq '(')
 190                 {  $parameter .= $token;  }
 191             else
 192                 {  $beforeParameters .= $token;  };
 193             };
 194         };
 195
 196     push @parameterLines, $parameter;
 197
 198     foreach my $item (\$beforeParameters, \$afterParameters)
 199         {
 200         $$item =~ s/^ //;
 201         $$item =~ s/ $//;
 202         }
 203
 204     my $prototypeObject = NaturalDocs::Languages::Prototype->New($beforeParameters, $afterParameters);
 205
 206
 207     # Parse the actual parameters.
 208
 209     foreach my $parameterLine (@parameterLines)
 210         {
 211         $prototypeObject->AddParameter( $self->ParseParameterLine($parameterLine) );
 212         };
 213
 214     return $prototypeObject;
 215     };
 216
 217
 218 #
 219 #   Function: ParseParameterLine
 220 #
 221 #   Parses a prototype parameter line and returns it as a <NaturalDocs::Languages::Prototype::Parameter> object.
 222 #
 223 sub ParseParameterLine #(line)
 224     {
 225     my ($self, $line) = @_;
 226
 227     $line =~ s/^ //;
 228     $line =~ s/ $//;
 229
 230     my @tokens = $line =~ /([^\(\)\[\]\{\}\<\>\'\"\:\=\ ]+|\:\=|.)/g;
 231
 232     my ($name, $type, $defaultValue, $defaultValuePrefix, $inType, $inDefaultValue);
 233
 234
 235     my @symbolStack;
 236
 237     foreach my $token (@tokens)
 238         {
 239         if ($inDefaultValue)
 240             {  $defaultValue .= $token;  }
 241
 242         elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
 243             {
 244             if ($inType)
 245                 {  $type .= $token;  }
 246             else
 247                 {  $name .= $token;  };
 248
 249             if ($token eq $symbolStack[-1])
 250                 {  pop @symbolStack;  };
 251             }
 252
 253         elsif ($token =~ /^[\(\[\{\<\'\"]$/)
 254             {
 255             if ($inType)
 256                 {  $type .= $token;  }
 257             else
 258                 {  $name .= $token;  };
 259
 260             push @symbolStack, $token;
 261             }
 262
 263         elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
 264                  ($token eq ']' && $symbolStack[-1] eq '[') ||
 265                  ($token eq '}' && $symbolStack[-1] eq '{') ||
 266                  ($token eq '>' && $symbolStack[-1] eq '<') )
 267             {
 268             if ($inType)
 269                 {  $type .= $token;  }
 270             else
 271                 {  $name .= $token;  };
 272
 273             pop @symbolStack;
 274             }
 275
 276         elsif ($token eq ' ')
 277             {
 278             if ($inType)
 279                 {  $type .= $token;  }
 280             elsif (!scalar @symbolStack)
 281                 {  $inType = 1;  }
 282             else
 283                 {  $name .= $token;  };
 284             }
 285
 286         elsif ($token eq ':=' || $token eq '=')
 287             {
 288             if (!scalar @symbolStack)
 289                 {
 290                 $defaultValuePrefix = $token;
 291                 $inDefaultValue = 1;
 292                 }
 293             elsif ($inType)
 294                 {  $type .= $token;  }
 295             else
 296                 {  $name .= $token;  };
 297             }
 298
 299         else
 300             {
 301             if ($inType)
 302                 {  $type .= $token;  }
 303             else
 304                 {  $name .= $token;  };
 305             };
 306         };
 307
 308     foreach my $part (\$type, \$defaultValue)
 309         {
 310         $$part =~ s/ $//;
 311         };
 312
 313     return NaturalDocs::Languages::Prototype::Parameter->New($type, undef, $name, undef, $defaultValue, $defaultValuePrefix);
 314     };
 315
 316
 317 sub TypeBeforeParameter
 318     {  return 0;  };
 319
 320 1;