view release on metacpan or  search on metacpan

lib/CORBA/IDL/Lexer.pm  view on Meta::CPAN

                s/^\*//
                        and $flag = 1,
                        last;
            }
            s/^([ \t\f\013]+)//
                    and $parser->YYData->{doc} .= $1,
                    last;
            s/^(.[\w \t]*)//
                    and $parser->YYData->{doc} .= $1,
                    $flag = 1,
                    last;
        }
    }
}

sub _DocAfterLexer {
    my ($parser) = @_;

    unless (defined $parser->YYData->{curr_node}) {
        $parser->_DocLexer();
        return;
    }

    unless (exists $parser->YYData->{curr_node}->{doc}) {
        $parser->YYData->{curr_node}->{doc} = q{};
    }
    my $flag = 1;
    while (1) {
            $parser->YYData->{line}
        or  $parser->YYData->{line} = readline $parser->YYData->{fh}
        or  return;

        for ($parser->YYData->{line}) {
            s/^(\n)//
                    and $parser->YYData->{lineno} ++,
                        $parser->YYData->{curr_node}->{doc} .= $1,
                        $flag = 0,
                        last;
            s/^\r//
                    and last;
            s/^\*\///
                    and return;
            unless ($flag) {
                s/^\*//
                        and $flag = 1,
                        last;
            }
            s/^([ \t\f\013]+)//
                    and $parser->YYData->{curr_node}->{doc} .= $1,
                    last;
            s/^(.[\w \t]*)//
                    and $parser->YYData->{curr_node}->{doc} .= $1,
                    $flag = 1,
                    last;
        }
    }
}

sub _CodeLexer {
    my ($parser) = @_;
    my $frag = q{};

    while (1) {
            $parser->YYData->{line}
        or  $parser->YYData->{line} = readline $parser->YYData->{fh}
        or  return;

        for ($parser->YYData->{line}) {
            s/^(\n)//
                    and $parser->YYData->{lineno} ++,
                        $frag .= $1,
                        last;
            s/^%\}.*//
                    and return ('CODE_FRAGMENT', $frag);
            s/^(.[^%\n]*)//
                    and $frag .= $1,
                        last;
        }
    }
}

sub _PragmaLexer {                      #   10.6.5  Pragma Directives for RepositoryId
    my ($parser, $line) = @_;

    for ($line) {
        s/^ID[ \t]+([0-9A-Za-z_:]+)[ \t]+\"([^\s">]+)\"//
                and $parser->YYData->{symbtab}->PragmaID($1,$2),
                    return;
        s/^prefix[ \t]+\"([0-9A-Za-z_:\.\/\-]*)\"//
                and $parser->YYData->{symbtab}->PragmaPrefix($1),
                    return;
        s/^version[ \t]+([0-9A-Za-z_:]+)[ \t]+([0-9]+)\.([0-9]+)//
                and $parser->YYData->{symbtab}->PragmaVersion($1,$2,$3),
                    return;

        $parser->Info("Non standard pragma.\n");
        return;
    }
}

sub _AttachDoc {
    my ($parser, $comment) = @_;

    if (defined $parser->YYData->{curr_node}) {
        if (exists $parser->YYData->{curr_node}->{doc}) {
            $parser->YYData->{curr_node}->{doc} .= $comment;
        }
        else {
            $parser->YYData->{curr_node}->{doc} = $comment;
        }
    }
}

sub Lexer {
    my ($parser) = @_;

    while (1) {
            $parser->YYData->{line}
        or  $parser->YYData->{line} = readline $parser->YYData->{fh}
        or  return (q{}, undef);

        unless (exists $parser->YYData->{srcname}) {
            if ($parser->YYData->{line} =~ /^#\s*(line\s+)?\d+\s+["<]([^\s">]+)[">]\s*\n/ ) {
                $parser->YYData->{srcname} = $2;
            }
            else {
                print "INTERNAL_ERROR:_Lexer\n";
            }
            if (defined $parser->YYData->{srcname}) {
                my @st = stat($parser->YYData->{srcname});
                $parser->YYData->{srcname_size} = $st[7];
                $parser->YYData->{srcname_mtime} = $st[9];
            }
        }

        for ($parser->YYData->{line}) {
            s/^#\s+[\d]+\s+"<[^>]+>"\s*\d*\s*\n//                   # cpp 3.2.3 ("<build-in>", "<command line> [\d]")
                    and last;

            s/^#\s+([\d]+)\s+["<]([^\s">]+)[">]\s+([\d]+)\s*\n//    # cpp
                    and $parser->YYData->{lineno} = $1,
                        $parser->YYData->{filename} = $2,
                        $parser->YYData->{doc} = q{},
                        $parser->YYData->{curr_node} = undef,
                        last;

            s/^#\s+([\d]+)\s+["<]([^\s">]+)[">]\s*\n//              # cpp
                    and $parser->YYData->{lineno} = $1,
                        $parser->YYData->{filename} = $2,
                        $parser->YYData->{doc} = q{},
                        $parser->YYData->{curr_node} = undef,
                        last;
            s/^#\s*line\s+([\d]+)\s+["<]([^\s">]+)[">]\s*\n//       # CL.EXE Microsoft VC
                    and $parser->YYData->{lineno} = $1,
                        $parser->YYData->{filename} = $2,
                        $parser->YYData->{doc} = q{},
                        $parser->YYData->{curr_node} = undef,
                        last;

            s/^[ \r\t\f\013]+//;                            # whitespaces
            s/^\n//
                    and $parser->YYData->{lineno} ++,
                        $parser->YYData->{curr_node} = undef,
                        last;

            s/^#pragma\s+(.*)\n//
                    and _PragmaLexer($parser, $1),
                        $parser->YYData->{lineno} ++,
                        $parser->YYData->{curr_node} = undef,
                        last;

            s/^\/\*\*<//                                    # documentation after
                    and _DocAfterLexer($parser),
                        last;
            s/^\/\*\*//                                     # documentation
                    and _DocLexer($parser),
                        last;
            s/^\/\/\/(.*)\n//                               # single line documentation
                    and _AttachDoc($parser, $1),
                    and $parser->YYData->{lineno} ++,
                        last;

            s/^\/\*//                                       # multiple line comment
                    and _CommentLexer($parser),
                        last;
            s/^\/\/.*\n//                                   # single line comment
                    and $parser->YYData->{lineno} ++,
                        $parser->YYData->{curr_node} = undef,
                        last;

            s/^%\{//                                        # code fragment
                    and return _CodeLexer($parser);

            if ($parser->YYData->{prop}) {
                s/^([A-Za-z][0-9A-Za-z_]*)//
                        and return ('PROP_KEY', $1);

                s/^\(([^\)]+)\)//
                        and return ('PROP_VALUE', $1);
            }

            if ($parser->YYData->{native}) {
                s/^([^\)]+)\)//
                        and return ('NATIVE_TYPE', $1);
            }

            s/^__declspec\s*\(\s*([A-Za-z]*)\s*\)//
                    and return ('DECLSPEC', $1);

            s/^([0-9]+)([Dd])//
                    and $parser->YYData->{lexeme} = $1 . $2,
                        return ('FIXED_PT_LITERAL', new Math::BigFloat($1));
            s/^([0-9]+\.)([Dd])//
                    and $parser->YYData->{lexeme} = $1 . $2,
                        return ('FIXED_PT_LITERAL', new Math::BigFloat($1));
            s/^(\.[0-9]+)([Dd])//
                    and $parser->YYData->{lexeme} = $1 . $2,
                        return ('FIXED_PT_LITERAL', new Math::BigFloat($1));
            s/^([0-9]+\.[0-9]+)([Dd])//
                    and $parser->YYData->{lexeme} = $1 . $2,
                        return ('FIXED_PT_LITERAL', new Math::BigFloat($1));

            s/^([0-9]+\.[0-9]+[Ee][+\-]?[0-9]+)//
                    and $parser->YYData->{lexeme} = $1,
                        return ('FLOATING_PT_LITERAL', new Math::BigFloat($1));
            s/^([0-9]+[Ee][+\-]?[0-9]+)//
                    and $parser->YYData->{lexeme} = $1,
                        return ('FLOATING_PT_LITERAL', new Math::BigFloat($1));
            s/^(\.[0-9]+[Ee][+\-]?[0-9]+)//
                    and $parser->YYData->{lexeme} = $1,
                        return ('FLOATING_PT_LITERAL', new Math::BigFloat($1));
            s/^([0-9]+\.[0-9]+)//
                    and $parser->YYData->{lexeme} = $1,
                        return ('FLOATING_PT_LITERAL', new Math::BigFloat($1));
            s/^([0-9]+\.)//
                    and $parser->YYData->{lexeme} = $1,
                        return ('FLOATING_PT_LITERAL', new Math::BigFloat($1));
            s/^(\.[0-9]+)//
                    and $parser->YYData->{lexeme} = $1,
                        return ('FLOATING_PT_LITERAL', new Math::BigFloat($1));

            s/^0([0-7]+)//
                    and $parser->YYData->{lexeme} = '0' . $1,
                        return _OctInteger($parser, $1);
            s/^(0[Xx])([A-Fa-f0-9]+)//
                    and $parser->YYData->{lexeme} = $1 . $2,
                        return _HexInteger($parser, $2);
            s/^(0)//
                    and $parser->YYData->{lexeme} = $1,
                        return ('INTEGER_LITERAL', new Math::BigInt($1));
            s/^([1-9][0-9]*)//