#188 Perl classes: Supporting moose superclasses and roles

[Johannes Kilian]

Generating class hierarchies does not consider moose syntax for defining superclasses and roles.

Therefore moose superclasses (base classes) are not considered in generated output.

I provided a simple patch which supports this feature. (see attachment)

[Johannes Kilian]

Ooops - forgot attachment, and I'm not able to add it afterwards ...

Here it is:

---

269,270d268
< # > extends [superclass] (Extension: jbkilian 20110620)
< # > with [roles] (Extension: jbkilian 20110620)
278c276
<

---

292d289
<
294,298d290
< elsif (lc($tokens->[$$indexRef]) eq 'extends' || lc($tokens->[$$indexRef]) eq 'with')
< {
< # Extension by jbkilian: support parsing of moose superclasses and roles
< $index = $$indexRef + 1;
< $lineNumber = $$lineNumberRef;
300,303d291
< $self->TryToSkipWhitespace(\$index, \$lineNumber);
<
< $parents = $self->TryToGetListOfClassesFromExtends(\$index, \$lineNumber);
< }
714,819d701
< #
< # Function: TryToGetListOfClassesFromExtends
< #
< # Attempts to retrieve a list of superclasses from the moose "extend" or "with" syntax.
< # Returns an arrayref of them if any are found, or undef if none.
< # It stops the moment it reaches a non-string outside of {...}, so "string1, variable, string2" will only return string1
< # but "string1 => {blabla}, string2 => {blahblah}, string3" will return string1, string2, string3.
< #
< # This function is a simple modification of TryToGetListOfStrings
< #
< # Supported Syntaxes:
< #
< # - Supports parenthesis.
< # - Supports all string forms supported by <TryToSkipString()>.
< # - Supports qw() string arrays.
< # - Supports skipping of options of superlasses given as hash references
< #
< # Author:
< # jbkilian - 20110620
< sub TryToGetListOfClassesFromExtends #(indexRef, lineNumberRef)
< {
< my ($self, $indexRef, $lineNumberRef) = @_;
< my $tokens = $self->Tokens();
<
< my $parenthesis1 = 0;
< my $parenthesis2 = 0;
< my $strings;
<
< while ($$indexRef < scalar @$tokens)
< {
< # We'll tolerate parenthesis.
< if ($tokens->[$$indexRef] eq '(')
< {
< $$indexRef++;
< $parenthesis1++;
< }
< elsif ($tokens->[$$indexRef] eq ')')
< {
< if ($parenthesis1 == 0)
< { last; };
<
< $$indexRef++;
< $parenthesis1--;
< }
< # Separate handling of '{' - since we have to skip anything between {...}
< elsif ($tokens->[$$indexRef] eq '{')
< {
< $$indexRef++;
< $parenthesis2++;
< }
< elsif ($tokens->[$$indexRef] eq '}')
< {
< if ($parenthesis2 == 0)
< { last; };
<
< $$indexRef++;
< $parenthesis2--;
< }
< elsif ($tokens->[$$indexRef] eq ',' || $tokens->[$$indexRef] eq '=' || $tokens->[$$indexRef] eq '>')
< {
< $$indexRef++;
< }
< else
< {
< my ($startContent, $endContent);
< my $symbolIndex = $$indexRef;
<
< if ($self->TryToSkipString($indexRef, $lineNumberRef, \$startContent, \$endContent))
< {
< my $content = $self->CreateString($startContent, $endContent);
<
< if (!defined $strings)
< { $strings = [ ]; };
<
< if (lc($tokens->[$symbolIndex]) eq 'qw')
< {
< $content =~ tr/ \t\n/ /s;
< $content =~ s/^ //;
<
< my @qwStrings = split(/ /, $content);
<
< push @$strings, @qwStrings;
< }
< else
< {
< push @$strings, $content;
< };
< }
< else
< {
< # Anything between {...} is ignored ...
< if ($parenthesis2 != 0) {
< $$indexRef++;
< }
< else {
< last;
< }
< };
< };
<
< $self->TryToSkipWhitespace($indexRef, $lineNumberRef);
< };
<
< return $strings;
< };
<