view release on metacpan or  search on metacpan

lib/CORBA/HTML/NameVisitor.pm  view on Meta::CPAN

#
#           Interface Definition Language (OMG IDL CORBA v3.0)
#

package CORBA::HTML::NameVisitor;

use strict;
use warnings;

our $VERSION = '2.60';

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless $self, $class;
    my ($parser) = @_;
    $self->{symbtab} = $parser->YYData->{symbtab};
    return $self;
}

sub _get_name {
    my $self = shift;
    my ($node, $scope) = @_;
    my $full = $node->{full};
    $full =~ s/^:://;
    my @list_name = split /::/, $full;
    my @list_scope = split /::/, $scope;
    while (@list_scope) {
        last if ($list_scope[0] ne $list_name[0]);
        shift @list_name;
        shift @list_scope;
    }
    my $name = join '::', @list_name;
    my $fragment = $node->{idf};
    $fragment = $node->{html_name} if (exists $node->{html_name});
    if (exists $node->{file_html}) {
        my $a = '<a href="' . $node->{file_html} . '#' . $fragment . '">' . $name . '</a>';
        return $a;
    }
    elsif ( $node->isa('BaseInterface') or $node->isa('ForwardBaseInterface') ) {
        my $filename = $node->{full};
        $filename =~ s/::/_/g;
        $filename .= '.html';
        my $a = '<a href="' . $filename . '#' . $fragment . '">' . $name . '</a>';
        return $a;
    }
    else {
        return $name;
    }
}

sub _get_lexeme {
    my $self = shift;
    my ($node) = @_;
    my $value = $node->{lexeme};
    $value =~ s/&/"&amp;"/g;
    $value =~ s/</"&lt;"/g;
    $value =~ s/>/"&gt;"/g;
    return $value;
}

sub _get_defn {
    my $self = shift;
    my ($defn) = @_;
    if (ref $defn) {
        return $defn;
    }
    else {
        return $self->{symbtab}->Lookup($defn);
    }
}

#
#   3.8     Interface Declaration
#

sub visitBaseInterface {
    my $self = shift;
    my ($node, $scope) = @_;
    return $self->_get_name($node, $scope);
}

sub visitForwardBaseInterface {
    my $self = shift;
    my ($node, $scope) = @_;
    return $self->_get_name($node, $scope);
}

#
#   3.10    Constant Declaration
#

sub visitConstant {
    my $self = shift;
    my ($node, $scope) = @_;
    return $self->_get_name($node, $scope);
}

sub _Eval {
    my $self = shift;
    my ($list_expr, $scope, $type) = @_;
    my $elt = pop @{$list_expr};
    unless (ref $elt) {
        $elt = $self->{symbtab}->Lookup($elt);