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