view release on metacpan or  search on metacpan

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

                    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;