2N/A#
2N/A# CDDL HEADER START
2N/A#
2N/A# The contents of this file are subject to the terms of the
2N/A# Common Development and Distribution License (the "License").
2N/A# You may not use this file except in compliance with the License.
2N/A#
2N/A# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
2N/A# or http://www.opensolaris.org/os/licensing.
2N/A# See the License for the specific language governing permissions
2N/A# and limitations under the License.
2N/A#
2N/A# When distributing Covered Code, include this CDDL HEADER in each
2N/A# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
2N/A# If applicable, add the following below this CDDL HEADER, with the
2N/A# fields enclosed by brackets "[]" replaced with your own identifying
2N/A# information: Portions Copyright [yyyy] [name of copyright owner]
2N/A#
2N/A# CDDL HEADER END
2N/A#
2N/A#
2N/A# Copyright (c) 2007, 2011, Oracle and/or its affiliates. All rights reserved.
2N/A#
2N/A
2N/Ause xmlHandlers;
2N/A
2N/Apackage externalEvent;
2N/A
2N/A1;
2N/A
2N/Asub new {
2N/A my $pkg = shift;
2N/A my $id = shift;
2N/A my $obj = shift;
2N/A
2N/A my @kid = $obj->getKids(); # kids of event are entry or allowed_types
2N/A
2N/A # separate kids into classes and create hash of entries and an
2N/A # array of includes
2N/A
2N/A my %entry = ();
2N/A my @entry = ();
2N/A my @allowed_types = ();
2N/A my @include = ();
2N/A my $internalName = '';
2N/A
2N/A my $kid;
2N/A foreach $kid (@kid) {
2N/A my $class = $kid->getClass();
2N/A my $kidId = $kid->getAttr('id');
2N/A
2N/A if ($class eq 'entry') {
2N/A my $tokenId = 'undefined';
2N/A my $format = '';
2N/A my $internal = $kid->getKid('internal');
2N/A if (defined $internal) {
2N/A $tokenId = $internal->getAttr('token');
2N/A $format = $internal->getAttr('format');
2N/A $format = '' unless defined $format;
2N/A }
2N/A my $comment;
2N/A my $commentKid = $kid->getKid('comment');
2N/A if (defined $commentKid) {
2N/A $comment = $commentKid->getContent;
2N/A }
2N/A my $external = $kid->getKid('external');
2N/A if (defined ($external)) {
2N/A $entry{$kidId} = [$external, $kid, $tokenId, $format, $comment];
2N/A push (@entry, $kidId);
2N/A }
2N/A else {
2N/A print STDERR "no external attributes defined for $id/$kidId\n";
2N/A $main::errExit = 3;
2N/A }
2N/A } # handle event id translation...
2N/A elsif ($class eq 'altname') {
2N/A $internalName = $kid->getAttr('id');
2N/A unless (defined $internalName) {
2N/A print STDERR "missing id for internal name of $id\n";
2N/A $internalName = 'error';
2N/A $main::errExit = 3;
2N/A }
2N/A }
2N/A elsif ($class eq 'allowed_types') {
2N/A my $content = $kid->getContent();
2N/A @allowed_types = (@allowed_types, split(/\s*,\s*/, $content));
2N/A }
2N/A }
2N/A my @entryCopy = @entry;
2N/A return bless {'id' => $id,
2N/A 'internalName' => $internalName,
2N/A 'allowed_types' => \@allowed_types,
2N/A 'entry' => \%entry,
2N/A 'entryList' => \@entry,
2N/A 'entryListCopy' => \@entryCopy,
2N/A 'include' => \@include,
2N/A 'xmlObj' => $obj}, $pkg;
2N/A}
2N/A
2N/A# return id
2N/A
2N/Asub getExternalName {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'id'};
2N/A}
2N/A
2N/A
2N/A# return internal name if it exists, else id
2N/A
2N/Asub getInternalName {
2N/A $pkg = shift;
2N/A
2N/A if ($pkg->{'internalName'}) {
2N/A return $pkg->{'internalName'};
2N/A }
2N/A else {
2N/A return $pkg->{'id'};
2N/A }
2N/A}
2N/A
2N/A# getNextEntry reads from 'entryList' destructively
2N/A# but resets when the list after the list is emptied
2N/A
2N/Asub getNextEntry {
2N/A my $pkg = shift;
2N/A
2N/A unless (@{$pkg->{'entryList'}}) {
2N/A @{$pkg->{'entryList'}} = @{$pkg->{'entryListCopy'}};
2N/A return undef;
2N/A }
2N/A my $id = shift @{$pkg->{'entryList'}};
2N/A
2N/A return ($pkg->getEntry($id)); # getEntry returns an array
2N/A}
2N/A
2N/A# getEntryIds returns list of all ids from entryList
2N/A
2N/Asub getEntryIds {
2N/A my $pkg = shift;
2N/A return (@{$pkg->{'entryList'}});
2N/A}
2N/A
2N/A# getEntry returns a selected entry for the current event
2N/A
2N/Asub getEntry {
2N/A my $pkg = shift;
2N/A my $id = shift; #entry id
2N/A
2N/A my $ref = $pkg->{'entry'};
2N/A my $array = $$ref{$id};
2N/A
2N/A return @$array;
2N/A}
2N/A
2N/A# getNextInclude reads from 'include' destructively
2N/A
2N/Asub getNextInclude {
2N/A my $pkg = shift;
2N/A
2N/A return shift @{$pkg->{'include'}};
2N/A}
2N/A
2N/A# getIncludes returns list of 'include'
2N/A
2N/Asub getIncludes {
2N/A my $pkg = shift;
2N/A return @{$pkg->{'include'}};
2N/A}
2N/A
2N/A# return a reference to the list of event id's allowed for
2N/A# this generic event
2N/A
2N/Asub getAllowedTypes {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'allowed_types'};
2N/A}
2N/A
2N/Apackage internalEvent;
2N/A
2N/A1;
2N/A
2N/Asub new {
2N/A my $pkg = shift;
2N/A my $id = shift;
2N/A my $obj = shift;
2N/A
2N/A my @kid = $obj->getKids(); # kids of event are entry
2N/A
2N/A my @entry = ();
2N/A
2N/A my $reorder = 0;
2N/A if ($reorder = $obj->getAttr('reorder')) {
2N/A $reorder = 1 if $reorder eq 'yes';
2N/A }
2N/A my $kid;
2N/A foreach $kid (@kid) {
2N/A my $class = $kid->getClass();
2N/A my $id = $kid->getAttr('id');
2N/A
2N/A if ($class eq 'entry') {
2N/A my $internal = $kid->getKid('internal');
2N/A if (defined ($internal)) {
2N/A push (@entry, [$internal, $kid]);
2N/A }
2N/A else {
2N/A print STDERR "no internal attributes defined for $id\n";
2N/A $main::errExit = 3;
2N/A }
2N/A }
2N/A }
2N/A return bless {'id' => $id,
2N/A 'reorder' => $reorder,
2N/A 'entry' => \@entry,
2N/A 'xmlObj' => $obj}, $pkg;
2N/A}
2N/A
2N/A# getEntries returns a list of all entry references
2N/A
2N/Asub getEntries {
2N/A my $pkg = shift;
2N/A
2N/A return undef unless @{$pkg->{'entry'}};
2N/A
2N/A return @{$pkg->{'entry'}};
2N/A}
2N/A
2N/Asub isReorder {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'reorder'};
2N/A}
2N/A
2N/Asub getId {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'id'};
2N/A}
2N/A
2N/Apackage eventDef;
2N/A
2N/A%uniqueId = ();
2N/A
2N/A1;
2N/A
2N/Asub new {
2N/A my $pkg = shift;
2N/A my $id = shift;
2N/A my $obj = shift;
2N/A my $super = shift;
2N/A
2N/A my $omit;
2N/A my $type;
2N/A my $header;
2N/A my $idNo;
2N/A my $javaToo;
2N/A my $title = '';
2N/A my @program = ();
2N/A my @see = ();
2N/A my @note = ();
2N/A
2N/A $omit = '' unless $omit = $obj->getAttr('omit');
2N/A $type = '' unless $type = $obj->getAttr('type');
2N/A $header = 0 unless $header = $obj->getAttr('header');
2N/A $idNo = '' unless $idNo = $obj->getAttr('idNo');
2N/A
2N/A if ($idNo ne '' && $uniqueId{$idNo}) {
2N/A print STDERR "$uniqueId{$idNo} and $id have the same id ($idNo)\n";
2N/A $main::errExit = 3;
2N/A }
2N/A else {
2N/A $uniqueId{$idNo} = $id;
2N/A }
2N/A
2N/A return bless {'id' => $id,
2N/A 'header' => $header,
2N/A 'idNo' => $idNo,
2N/A 'omit' => $omit,
2N/A 'super' => $super,
2N/A 'type' => $type,
2N/A 'title' => $title,
2N/A 'program' => \@program,
2N/A 'see' => \@see,
2N/A 'note' => \@note,
2N/A 'external' => 0,
2N/A 'internal' => 0}, $pkg;
2N/A}
2N/A
2N/A# putDef is called at the end of an <event></event> block, so
2N/A# it sees a completed object.
2N/A
2N/Asub putDef {
2N/A my $pkg = shift;
2N/A my $obj = shift; # ref to xmlHandlers event object
2N/A my $context = shift;
2N/A
2N/A my $id = $pkg->{'id'};
2N/A
2N/A if ($context eq 'internal') {
2N/A $pkg->{$context} = new internalEvent($id, $obj);
2N/A return undef;
2N/A } elsif ($context eq 'external') {
2N/A my $ref = $pkg->{$context} = new externalEvent($id, $obj);
2N/A return $ref->{'internalName'};
2N/A }
2N/A}
2N/A
2N/Asub getId {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'id'};
2N/A}
2N/A
2N/Asub getHeader {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'header'};
2N/A}
2N/A
2N/Asub getIdNo {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'idNo'};
2N/A}
2N/A
2N/Asub getSuperClass {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'super'};
2N/A}
2N/A
2N/Asub getOmit {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'omit'};
2N/A}
2N/A
2N/Asub getType {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'type'};
2N/A}
2N/A
2N/Asub getTitle {
2N/A return shift->{'title'};
2N/A}
2N/A
2N/Asub getProgram {
2N/A return shift->{'program'};
2N/A}
2N/A
2N/Asub getSee {
2N/A return shift->{'see'};
2N/A}
2N/A
2N/Asub getNote {
2N/A return shift->{'note'};
2N/A}
2N/A
2N/Asub getInternal {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'internal'};
2N/A}
2N/A
2N/Asub getExternal {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'external'};
2N/A}
2N/A
2N/A# this isn't fully implemented; just a skeleton
2N/A
2N/Apackage tokenDef;
2N/A
2N/A1;
2N/A
2N/Asub new {
2N/A my $pkg = shift;
2N/A my $obj = shift;
2N/A my $id = shift;
2N/A
2N/A $usage = $obj->getAttr('usage');
2N/A $usage = '' unless defined $usage;
2N/A
2N/A return bless {'id' => $id,
2N/A 'usage' => $usage
2N/A }, $pkg;
2N/A}
2N/A
2N/Asub getId {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'id'};
2N/A}
2N/A
2N/Asub getUsage {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'usage'};
2N/A}
2N/A
2N/Apackage messageList;
2N/A
2N/A1;
2N/A
2N/Asub new {
2N/A my $pkg = shift;
2N/A my $obj = shift;
2N/A my $id = shift;
2N/A my $header = shift;
2N/A my $start = shift;
2N/A my $public = shift;
2N/A my $deprecated = shift;
2N/A
2N/A my @msg = ();
2N/A
2N/A my @kid = $obj->getKids(); # kids of msg_list are msg
2N/A my $kid;
2N/A foreach $kid (@kid) {
2N/A my $class = $kid->getClass();
2N/A if ($class eq 'msg') {
2N/A my $text = $kid->getContent();
2N/A $text = '' unless defined ($text);
2N/A my $msgId = $kid->getAttr('id');
2N/A if (defined ($msgId)) {
2N/A push(@msg, join('::', $msgId, $text));
2N/A }
2N/A else {
2N/A print STDERR "missing id for $class <msg>\n";
2N/A $main::errExit = 3;
2N/A }
2N/A }
2N/A else {
2N/A print STDERR "invalid tag in <msg_list> block: $class\n";
2N/A $main::errExit = 3;
2N/A }
2N/A }
2N/A
2N/A return bless {'id' => $id,
2N/A 'header' => $header,
2N/A 'msg' => \@msg,
2N/A 'start' => $start,
2N/A 'public' => $public,
2N/A 'deprecated' => $deprecated
2N/A }, $pkg;
2N/A}
2N/A
2N/Asub getId {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'id'};
2N/A}
2N/A
2N/Asub getMsgStart {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'start'};
2N/A}
2N/A
2N/Asub getDeprecated {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'deprecated'};
2N/A}
2N/A
2N/Asub getMsgPublic {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'public'};
2N/A}
2N/A
2N/Asub getHeader {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'header'};
2N/A}
2N/A
2N/A# destructive read of @msg...
2N/A
2N/Asub getNextMsg {
2N/A my $pkg = shift;
2N/A
2N/A my @msg = @{$pkg->{'msg'}};
2N/A
2N/A return undef unless @msg;
2N/A
2N/A my $text = pop(@msg);
2N/A $pkg->{'msg'} = \@msg;
2N/A return $text;
2N/A}
2N/A
2N/A# returns all msgs
2N/Asub getMsgs {
2N/A my $pkg = shift;
2N/A
2N/A return @{$pkg->{'msg'}};
2N/A}
2N/A
2N/Apackage noteList;
2N/A
2N/A1;
2N/A
2N/Asub new {
2N/A my $pkg = shift;
2N/A my $obj = shift;
2N/A my $id = shift;
2N/A
2N/A my %notes = ();
2N/A
2N/A my @kid = $obj->getKids(); # kids of note_list are note
2N/A my $kid;
2N/A foreach $kid (@kid) {
2N/A my $class = $kid->getClass();
2N/A if ($class eq 'note') {
2N/A my $text = $kid->getContent();
2N/A $text = '' unless defined ($text);
2N/A my $note_id = $kid->getAttr('id');
2N/A if (defined ($note_id)) {
2N/A $notes{$note_id} = $text;
2N/A }
2N/A else {
2N/A print STDERR "missing id for $class <note>\n";
2N/A $main::errExit = 3;
2N/A }
2N/A }
2N/A else {
2N/A print STDERR "invalid tag in <note_list> block: $class\n";
2N/A $main::errExit = 3;
2N/A }
2N/A }
2N/A
2N/A return bless {'id' => $id,
2N/A 'notes' => \%notes,
2N/A }, $pkg;
2N/A}
2N/A
2N/Asub getId {
2N/A my $pkg = shift;
2N/A
2N/A return $pkg->{'id'};
2N/A}
2N/A
2N/Asub getNotes {
2N/A my $pkg = shift;
2N/A
2N/A return %{$pkg->{'notes'}};
2N/A}
2N/A
2N/Apackage auditxml;
2N/A
2N/A# These aren't internal state because the callback functions don't
2N/A# have the object handle.
2N/A
2N/A@debug = (); # stack for nesting debug state
2N/A%event = (); # event name => $objRef
2N/A@event = (); # event id
2N/A%token = (); # token name => $objRef
2N/A@token = (); # token id
2N/A%note_list = (); # noteList string list id to obj
2N/A%msg_list = (); # messageList string list id to obj
2N/A@msg_list = (); # id list
2N/A%service = (); # valid service names
2N/A%externalToInternal = (); # map external event name to internal event name
2N/A
2N/A1;
2N/A
2N/Asub new {
2N/A my $pkg = shift;
2N/A my $file = shift; # xml file to be parsed
2N/A
2N/A register('event', \&eventStart, \&eventEnd);
2N/A register('entry', 0, \&entry);
2N/A register('external', 0, \&external);
2N/A register('internal', 0, \&internal);
2N/A register('include', 0, \&include);
2N/A register('token', 0, \&token);
2N/A register('service', 0, \&service);
2N/A register('note_list', 0, \&note_list);
2N/A register('msg_list', 0, \&msg_list);
2N/A register('msg', 0, \&msg);
2N/A
2N/A # do not use register() for debug because register generates extra
2N/A # debug information
2N/A
2N/A xmlHandlers::registerStartCallback('debug', \&debugStart);
2N/A xmlHandlers::registerEndCallback('debug', \&debugEnd);
2N/A
2N/A $xml = new xmlHandlers(0, 'top level', $file);
2N/A
2N/A return bless {'xmlObj' => $xml,
2N/A 'firstToken' => 1,
2N/A 'firstEvent' => 1}, $pkg;
2N/A}
2N/A
2N/A# local function -- register both the auditxml function and the
2N/A# xmlHandler callback
2N/A
2N/Asub register {
2N/A my $localName = shift;
2N/A my $startFunction = shift;
2N/A my $endFunction = shift;
2N/A
2N/A if ($startFunction) {
2N/A xmlHandlers::registerStartCallback($localName, \&completed);
2N/A $startFunction{$localName} = $startFunction;
2N/A }
2N/A if ($endFunction) {
2N/A xmlHandlers::registerEndCallback($localName, \&completed);
2N/A $endFunction{$localName} = $endFunction;
2N/A }
2N/A}
2N/A
2N/Asub completed {
2N/A my $obj = shift;
2N/A my $callbackSource = shift;
2N/A
2N/A my $id = $obj->getAttr('id');
2N/A my $class = $obj->getClass();
2N/A
2N/A if ($main::debug) {
2N/A print "*** $callbackSource: $class", (defined ($id)) ? "= $id\n" : "\n";
2N/A
2N/A my %attributes = $obj->getAttributes();
2N/A my $attribute;
2N/A foreach $attribute (keys %attributes) {
2N/A print "*** $attribute = $attributes{$attribute}\n";
2N/A }
2N/A my $content = $obj->getContent();
2N/A print "*** content = $content\n" if defined $content;
2N/A }
2N/A if ($callbackSource eq 'start') {
2N/A &{$startFunction{$class}}($obj);
2N/A }
2N/A elsif ($callbackSource eq 'end') {
2N/A &{$endFunction{$class}}($obj);
2N/A }
2N/A else {
2N/A print STDERR "no auditxml function defined for $class\n";
2N/A $main::errExit = 3;
2N/A }
2N/A}
2N/A
2N/A# getNextEvent reads from @event destructively. 'firstEvent' could
2N/A# be used to make a copy from which to read.
2N/A
2N/Asub getNextEvent {
2N/A my $pkg = shift;
2N/A
2N/A return undef unless (@event);
2N/A if ($pkg->{'firstEvent'}) {
2N/A @token = sort @token;
2N/A $pkg->{'firstEvent'} = 1;
2N/A }
2N/A
2N/A my $id = shift @event;
2N/A
2N/A return $event{$id};
2N/A}
2N/A
2N/A# returns all event ids
2N/Asub getEventIds {
2N/A my $pkg = shift;
2N/A
2N/A return @event;
2N/A}
2N/A
2N/A# returns event for id
2N/Asub getEvent {
2N/A my $pkg = shift;
2N/A my $id = shift;
2N/A
2N/A return $event{$id};
2N/A}
2N/A
2N/Asub getToken {
2N/A my $pkg = shift;
2N/A my $id = shift;
2N/A
2N/A return $token{$id};
2N/A}
2N/A
2N/A# getNextToken reads from @token destructively. 'firstToken' could
2N/A# be used to make a copy from which to read.
2N/A
2N/Asub getNextToken {
2N/A my $pkg = shift;
2N/A
2N/A return undef unless (@token);
2N/A
2N/A if ($pkg->{'firstToken'}) {
2N/A @token = sort @token;
2N/A $pkg->{'firstToken'} = 1;
2N/A }
2N/A my $id = shift @token;
2N/A
2N/A return $token{$id};
2N/A}
2N/A
2N/A# return token Ids
2N/A
2N/Asub getTokenIds {
2N/A my $pkg = shift;
2N/A
2N/A return @token;
2N/A}
2N/A
2N/A# getNextMsgId reads from @msg_list destructively.
2N/A
2N/Asub getNextMsgId {
2N/A my $pkg = shift;
2N/A
2N/A return undef unless (@msg_list);
2N/A
2N/A my $id = shift @msg_list;
2N/A
2N/A return ($id, $msg_list{$id});
2N/A}
2N/A
2N/Asub getMsgIds {
2N/A my $pkg = shift;
2N/A
2N/A return @msg_list;
2N/A}
2N/A
2N/Asub getMsg {
2N/A my $pkg = shift;
2N/A my $id = shift;
2N/A
2N/A return $msg_list{$id};
2N/A}
2N/A
2N/Asub external {
2N/A}
2N/A
2N/Asub internal {
2N/A
2N/A}
2N/A
2N/Asub eventStart {
2N/A my $obj = shift;
2N/A
2N/A my $id = $obj->getAttr('id');
2N/A
2N/A unless ($id) {
2N/A print STDERR "eventStart can't get a valid id\n";
2N/A $main::errExit = 3;
2N/A return;
2N/A }
2N/A unless (defined $event{$id}) {
2N/A my $super;
2N/A if ($super = $obj->getAttr('instance_of')) {
2N/A $super = $event{$super};
2N/A } else {
2N/A $super = 0;
2N/A }
2N/A $event{$id} = new eventDef($id, $obj, $super);
2N/A push (@event, $id);
2N/A } else {
2N/A print STDERR "duplicate event id: $id\n";
2N/A $main::errExit = 3;
2N/A }
2N/A}
2N/A
2N/Asub eventEnd {
2N/A my $obj = shift;
2N/A
2N/A my $id = $obj->getAttr('id');
2N/A unless (defined $id) {
2N/A print STDERR "event element is missing required id attribute\n";
2N/A $main::errExit = 3;
2N/A return;
2N/A }
2N/A print "event = $id\n" if $main::debug;
2N/A
2N/A foreach my $kid ($obj->getKids) {
2N/A my $class = $kid->getClass;
2N/A next unless ($class =~ /title|program|see|note/);
2N/A my $content = $kid->getContent;
2N/A $content = '' unless defined $content;
2N/A if ($class eq 'title') {
2N/A $event{$id}->{$class} = $content;
2N/A } elsif ($class eq 'note') {
2N/A my $note_list_id = $kid->getAttr('list');
2N/A my $note_id = $kid->getAttr('id');
2N/A my $note_pos = $kid->getAttr('position');
2N/A
2N/A $note_pos = 'pre' unless defined $note_pos;
2N/A if (defined $note_list_id && defined $note_id &&
2N/A defined $note_list{$note_list_id}) {
2N/A my %note_hash_ref = $note_list{$note_list_id}->getNotes;
2N/A if (defined $note_hash_ref{$note_id}) {
2N/A if ($note_pos eq 'pre') {
2N/A $content = "$note_hash_ref{$note_id} $content";
2N/A } else {
2N/A $content = "$content $note_hash_ref{$note_id}";
2N/A }
2N/A }
2N/A }
2N/A push @{$event{$id}->{$class}}, $content;
2N/A } else {
2N/A push @{$event{$id}->{$class}}, $content;
2N/A }
2N/A }
2N/A $event{$id}->putDef($obj, 'internal');
2N/A
2N/A my $internalName = $event{$id}->putDef($obj, 'external');
2N/A
2N/A $externalToInternal{$id} = $internalName if $internalName;
2N/A}
2N/A
2N/A# class method
2N/A
2N/A#sub getInternalName {
2N/A# my $name = shift;
2N/A#
2N/A# return $externalToInternal{$name};
2N/A#}
2N/A
2N/Asub entry {
2N/A}
2N/A
2N/A#sub include {
2N/A# my $obj = shift;
2N/A#
2N/A# my $id = $obj->getAttr('id');
2N/A#
2N/A# if (defined $id) {
2N/A# print "include = $id\n" if $main::debug;
2N/A# }
2N/A# else {
2N/A# print STDERR "include element is missing required id attribute\n";
2N/A# $main::errExit = 3;
2N/A# }
2N/A#}
2N/A
2N/Asub token {
2N/A my $obj = shift;
2N/A
2N/A my $id = $obj->getAttr('id');
2N/A
2N/A if (defined $id) {
2N/A print "token = $id\n" if $main::debug;
2N/A $token{$id} = new tokenDef($obj, $id);
2N/A push (@token, $id);
2N/A }
2N/A else {
2N/A print STDERR "token element is missing required id attribute\n";
2N/A $main::errExit = 3;
2N/A }
2N/A}
2N/A
2N/Asub msg_list {
2N/A my $obj = shift;
2N/A
2N/A my $id = $obj->getAttr('id');
2N/A my $header = $obj->getAttr('header');
2N/A my $start = $obj->getAttr('start');
2N/A my $public = $obj->getAttr('public');
2N/A my $deprecated = $obj->getAttr('deprecated');
2N/A
2N/A $header = 0 unless $header;
2N/A $start = 0 unless $start;
2N/A $public = ($public) ? 1 : 0;
2N/A $deprecated = ($deprecated) ? 1 : 0;
2N/A
2N/A if (defined $id) {
2N/A print "msg_list = $id\n" if $main::debug;
2N/A $msg_list{$id} = new messageList($obj, $id, $header, $start,
2N/A $public, $deprecated);
2N/A push (@msg_list, $id);
2N/A }
2N/A else {
2N/A print STDERR
2N/A "msg_list element is missing required id attribute\n";
2N/A $main::errExit = 3;
2N/A }
2N/A}
2N/A
2N/Asub msg {
2N/A# my $obj = shift;
2N/A}
2N/A
2N/Asub note_list {
2N/A my $obj = shift;
2N/A
2N/A my $id = $obj->getAttr('id');
2N/A
2N/A if (defined $id) {
2N/A if (defined $note_list{$id}) {
2N/A print STDERR "note_list \'$id\' already defined\n";
2N/A $main::errExit = 3;
2N/A return;
2N/A }
2N/A print "note_list = $id\n" if $main::debug;
2N/A $note_list{$id} = new noteList($obj, $id);
2N/A }
2N/A else {
2N/A print STDERR
2N/A "note_list element is missing required id attribute\n";
2N/A $main::errExit = 3;
2N/A }
2N/A}
2N/A
2N/A# Service name was dropped during PSARC review
2N/A
2N/Asub service {
2N/A my $obj = shift;
2N/A
2N/A my $name = $obj->getAttr('name');
2N/A my $id = $obj->getAttr('id');
2N/A
2N/A if ((defined $id) && (defined $name)) {
2N/A print "service $name = $id\n" if $main::debug;
2N/A $service{$name} = $id;
2N/A }
2N/A elsif (defined $name) {
2N/A print STDERR "service $name is missing an id number\n";
2N/A $main::errExit = 3;
2N/A }
2N/A elsif (defined $id) {
2N/A print STDERR "service name missing for id = $id\n";
2N/A $main::errExit = 3;
2N/A }
2N/A else {
2N/A print STDERR "missing both name and id for a service entry\n";
2N/A $main::errExit = 3;
2N/A }
2N/A}
2N/A
2N/A#sub getServices {
2N/A#
2N/A# return %service;
2N/A#}
2N/A
2N/A# <debug set="on"> or <debug set="off"> or <debug>
2N/A# if the set attribute is omitted, debug state is toggled
2N/A
2N/A# debugStart / debugEnd are used to insure debug state is
2N/A# scoped to the block between <debug> and </debug>
2N/A
2N/Asub debugStart {
2N/A my $obj = shift;
2N/A
2N/A push (@debug, $main::debug);
2N/A my $debug = $main::debug;
2N/A
2N/A my $state = $obj->getAttr('set');
2N/A
2N/A if (defined $state) {
2N/A $main::debug = ($state eq 'on') ? 1 : 0;
2N/A }
2N/A else {
2N/A $main::debug = !$debug;
2N/A }
2N/A if ($debug != $main::debug) {
2N/A print 'debug is ', $main::debug ? 'on' : 'off', "\n";
2N/A }
2N/A}
2N/A
2N/Asub debugEnd {
2N/A my $obj = shift;
2N/A
2N/A my $debug = $main::debug;
2N/A $main::debug = pop (@debug);
2N/A
2N/A if ($debug != $main::debug) {
2N/A print 'debug is ', $main::debug ? 'on' : 'off', "\n";
2N/A }
2N/A}