1*c0c79a3fStz204579# 2*c0c79a3fStz204579# CDDL HEADER START 3*c0c79a3fStz204579# 4*c0c79a3fStz204579# The contents of this file are subject to the terms of the 5*c0c79a3fStz204579# Common Development and Distribution License (the "License"). 6*c0c79a3fStz204579# You may not use this file except in compliance with the License. 7*c0c79a3fStz204579# 8*c0c79a3fStz204579# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 9*c0c79a3fStz204579# or http://www.opensolaris.org/os/licensing. 10*c0c79a3fStz204579# See the License for the specific language governing permissions 11*c0c79a3fStz204579# and limitations under the License. 12*c0c79a3fStz204579# 13*c0c79a3fStz204579# When distributing Covered Code, include this CDDL HEADER in each 14*c0c79a3fStz204579# file and include the License file at usr/src/OPENSOLARIS.LICENSE. 15*c0c79a3fStz204579# If applicable, add the following below this CDDL HEADER, with the 16*c0c79a3fStz204579# fields enclosed by brackets "[]" replaced with your own identifying 17*c0c79a3fStz204579# information: Portions Copyright [yyyy] [name of copyright owner] 18*c0c79a3fStz204579# 19*c0c79a3fStz204579# CDDL HEADER END 20*c0c79a3fStz204579# 21*c0c79a3fStz204579# 22*c0c79a3fStz204579# Copyright 2007 Sun Microsystems, Inc. All rights reserved. 23*c0c79a3fStz204579# Use is subject to license terms. 24*c0c79a3fStz204579# 25*c0c79a3fStz204579# ident "%Z%%M% %I% %E% SMI" 26*c0c79a3fStz204579# 27*c0c79a3fStz204579 28*c0c79a3fStz204579use xmlHandlers; 29*c0c79a3fStz204579 30*c0c79a3fStz204579package externalEvent; 31*c0c79a3fStz204579 32*c0c79a3fStz2045791; 33*c0c79a3fStz204579 34*c0c79a3fStz204579sub new { 35*c0c79a3fStz204579 my $pkg = shift; 36*c0c79a3fStz204579 my $id = shift; 37*c0c79a3fStz204579 my $obj = shift; 38*c0c79a3fStz204579 39*c0c79a3fStz204579 my @kid = $obj->getKids(); # kids of event are entry or allowed_types 40*c0c79a3fStz204579 41*c0c79a3fStz204579 # separate kids into classes and create hash of entries and an 42*c0c79a3fStz204579 # array of includes 43*c0c79a3fStz204579 44*c0c79a3fStz204579 my %entry = (); 45*c0c79a3fStz204579 my @entry = (); 46*c0c79a3fStz204579 my @allowed_types = (); 47*c0c79a3fStz204579 my @include = (); 48*c0c79a3fStz204579 my $internalName = ''; 49*c0c79a3fStz204579 50*c0c79a3fStz204579 my $kid; 51*c0c79a3fStz204579 foreach $kid (@kid) { 52*c0c79a3fStz204579 my $class = $kid->getClass(); 53*c0c79a3fStz204579 my $kidId = $kid->getAttr('id'); 54*c0c79a3fStz204579 55*c0c79a3fStz204579 if ($class eq 'entry') { 56*c0c79a3fStz204579 my $tokenId = 'undefined'; 57*c0c79a3fStz204579 my $format = ''; 58*c0c79a3fStz204579 my $internal = $kid->getKid('internal'); 59*c0c79a3fStz204579 if (defined $internal) { 60*c0c79a3fStz204579 $tokenId = $internal->getAttr('token'); 61*c0c79a3fStz204579 $format = $internal->getAttr('format'); 62*c0c79a3fStz204579 $format = '' unless defined $format; 63*c0c79a3fStz204579 } 64*c0c79a3fStz204579 my $comment; 65*c0c79a3fStz204579 my $commentKid = $kid->getKid('comment'); 66*c0c79a3fStz204579 if (defined $commentKid) { 67*c0c79a3fStz204579 $comment = $commentKid->getContent; 68*c0c79a3fStz204579 } 69*c0c79a3fStz204579 my $external = $kid->getKid('external'); 70*c0c79a3fStz204579 if (defined ($external)) { 71*c0c79a3fStz204579 $entry{$kidId} = [$external, $kid, $tokenId, $format, $comment]; 72*c0c79a3fStz204579 push (@entry, $kidId); 73*c0c79a3fStz204579 } 74*c0c79a3fStz204579 else { 75*c0c79a3fStz204579 print STDERR "no external attributes defined for $id/$kidId\n"; 76*c0c79a3fStz204579 } 77*c0c79a3fStz204579 } # handle event id translation... 78*c0c79a3fStz204579 elsif ($class eq 'altname') { 79*c0c79a3fStz204579 $internalName = $kid->getAttr('id'); 80*c0c79a3fStz204579 unless (defined $internalName) { 81*c0c79a3fStz204579 print STDERR "missing id for internal name of $id\n"; 82*c0c79a3fStz204579 $internalName = 'error'; 83*c0c79a3fStz204579 } 84*c0c79a3fStz204579 } 85*c0c79a3fStz204579 elsif ($class eq 'allowed_types') { 86*c0c79a3fStz204579 my $content = $kid->getContent(); 87*c0c79a3fStz204579 @allowed_types = (@allowed_types, split(/\s*,\s*/, $content)); 88*c0c79a3fStz204579 } 89*c0c79a3fStz204579 } 90*c0c79a3fStz204579 my @entryCopy = @entry; 91*c0c79a3fStz204579 return bless {'id' => $id, 92*c0c79a3fStz204579 'internalName' => $internalName, 93*c0c79a3fStz204579 'allowed_types' => \@allowed_types, 94*c0c79a3fStz204579 'entry' => \%entry, 95*c0c79a3fStz204579 'entryList' => \@entry, 96*c0c79a3fStz204579 'entryListCopy' => \@entryCopy, 97*c0c79a3fStz204579 'include' => \@include, 98*c0c79a3fStz204579 'xmlObj' => $obj}, $pkg; 99*c0c79a3fStz204579} 100*c0c79a3fStz204579 101*c0c79a3fStz204579# return id 102*c0c79a3fStz204579 103*c0c79a3fStz204579sub getExternalName { 104*c0c79a3fStz204579 my $pkg = shift; 105*c0c79a3fStz204579 106*c0c79a3fStz204579 return $pkg->{'id'}; 107*c0c79a3fStz204579} 108*c0c79a3fStz204579 109*c0c79a3fStz204579 110*c0c79a3fStz204579# return internal name if it exists, else id 111*c0c79a3fStz204579 112*c0c79a3fStz204579sub getInternalName { 113*c0c79a3fStz204579 $pkg = shift; 114*c0c79a3fStz204579 115*c0c79a3fStz204579 if ($pkg->{'internalName'}) { 116*c0c79a3fStz204579 return $pkg->{'internalName'}; 117*c0c79a3fStz204579 } 118*c0c79a3fStz204579 else { 119*c0c79a3fStz204579 return $pkg->{'id'}; 120*c0c79a3fStz204579 } 121*c0c79a3fStz204579} 122*c0c79a3fStz204579 123*c0c79a3fStz204579# getNextEntry reads from 'entryList' destructively 124*c0c79a3fStz204579# but resets when the list after the list is emptied 125*c0c79a3fStz204579 126*c0c79a3fStz204579sub getNextEntry { 127*c0c79a3fStz204579 my $pkg = shift; 128*c0c79a3fStz204579 129*c0c79a3fStz204579 unless (@{$pkg->{'entryList'}}) { 130*c0c79a3fStz204579 @{$pkg->{'entryList'}} = @{$pkg->{'entryListCopy'}}; 131*c0c79a3fStz204579 return undef; 132*c0c79a3fStz204579 } 133*c0c79a3fStz204579 my $id = shift @{$pkg->{'entryList'}}; 134*c0c79a3fStz204579 135*c0c79a3fStz204579 return ($pkg->getEntry($id)); # getEntry returns an array 136*c0c79a3fStz204579} 137*c0c79a3fStz204579 138*c0c79a3fStz204579# getEntryIds returns list of all ids from entryList 139*c0c79a3fStz204579 140*c0c79a3fStz204579sub getEntryIds { 141*c0c79a3fStz204579 my $pkg = shift; 142*c0c79a3fStz204579 return (@{$pkg->{'entryList'}}); 143*c0c79a3fStz204579} 144*c0c79a3fStz204579 145*c0c79a3fStz204579# getEntry returns a selected entry for the current event 146*c0c79a3fStz204579 147*c0c79a3fStz204579sub getEntry { 148*c0c79a3fStz204579 my $pkg = shift; 149*c0c79a3fStz204579 my $id = shift; #entry id 150*c0c79a3fStz204579 151*c0c79a3fStz204579 my $ref = $pkg->{'entry'}; 152*c0c79a3fStz204579 my $array = $$ref{$id}; 153*c0c79a3fStz204579 154*c0c79a3fStz204579 return @$array; 155*c0c79a3fStz204579} 156*c0c79a3fStz204579 157*c0c79a3fStz204579# getNextInclude reads from 'include' destructively 158*c0c79a3fStz204579 159*c0c79a3fStz204579sub getNextInclude { 160*c0c79a3fStz204579 my $pkg = shift; 161*c0c79a3fStz204579 162*c0c79a3fStz204579 return shift @{$pkg->{'include'}}; 163*c0c79a3fStz204579} 164*c0c79a3fStz204579 165*c0c79a3fStz204579# getIncludes returns list of 'include' 166*c0c79a3fStz204579 167*c0c79a3fStz204579sub getIncludes { 168*c0c79a3fStz204579 my $pkg = shift; 169*c0c79a3fStz204579 return @{$pkg->{'include'}}; 170*c0c79a3fStz204579} 171*c0c79a3fStz204579 172*c0c79a3fStz204579# return a reference to the list of event id's allowed for 173*c0c79a3fStz204579# this generic event 174*c0c79a3fStz204579 175*c0c79a3fStz204579sub getAllowedTypes { 176*c0c79a3fStz204579 my $pkg = shift; 177*c0c79a3fStz204579 178*c0c79a3fStz204579 return $pkg->{'allowed_types'}; 179*c0c79a3fStz204579} 180*c0c79a3fStz204579 181*c0c79a3fStz204579package internalEvent; 182*c0c79a3fStz204579 183*c0c79a3fStz2045791; 184*c0c79a3fStz204579 185*c0c79a3fStz204579sub new { 186*c0c79a3fStz204579 my $pkg = shift; 187*c0c79a3fStz204579 my $id = shift; 188*c0c79a3fStz204579 my $obj = shift; 189*c0c79a3fStz204579 190*c0c79a3fStz204579 my @kid = $obj->getKids(); # kids of event are entry 191*c0c79a3fStz204579 192*c0c79a3fStz204579 my @entry = (); 193*c0c79a3fStz204579 194*c0c79a3fStz204579 my $reorder = 0; 195*c0c79a3fStz204579 if ($reorder = $obj->getAttr('reorder')) { 196*c0c79a3fStz204579 $reorder = 1 if $reorder eq 'yes'; 197*c0c79a3fStz204579 } 198*c0c79a3fStz204579 my $kid; 199*c0c79a3fStz204579 foreach $kid (@kid) { 200*c0c79a3fStz204579 my $class = $kid->getClass(); 201*c0c79a3fStz204579 my $id = $kid->getAttr('id'); 202*c0c79a3fStz204579 203*c0c79a3fStz204579 if ($class eq 'entry') { 204*c0c79a3fStz204579 my $internal = $kid->getKid('internal'); 205*c0c79a3fStz204579 if (defined ($internal)) { 206*c0c79a3fStz204579 push (@entry, [$internal, $kid]); 207*c0c79a3fStz204579 } 208*c0c79a3fStz204579 else { 209*c0c79a3fStz204579 print STDERR "no internal attributes defined for $id\n"; 210*c0c79a3fStz204579 } 211*c0c79a3fStz204579 } 212*c0c79a3fStz204579 } 213*c0c79a3fStz204579 return bless {'id' => $id, 214*c0c79a3fStz204579 'reorder' => $reorder, 215*c0c79a3fStz204579 'entry' => \@entry, 216*c0c79a3fStz204579 'xmlObj' => $obj}, $pkg; 217*c0c79a3fStz204579} 218*c0c79a3fStz204579 219*c0c79a3fStz204579# getEntries returns a list of all entry references 220*c0c79a3fStz204579 221*c0c79a3fStz204579sub getEntries { 222*c0c79a3fStz204579 my $pkg = shift; 223*c0c79a3fStz204579 224*c0c79a3fStz204579 return undef unless @{$pkg->{'entry'}}; 225*c0c79a3fStz204579 226*c0c79a3fStz204579 return @{$pkg->{'entry'}}; 227*c0c79a3fStz204579} 228*c0c79a3fStz204579 229*c0c79a3fStz204579sub isReorder { 230*c0c79a3fStz204579 my $pkg = shift; 231*c0c79a3fStz204579 232*c0c79a3fStz204579 return $pkg->{'reorder'}; 233*c0c79a3fStz204579} 234*c0c79a3fStz204579 235*c0c79a3fStz204579sub getId { 236*c0c79a3fStz204579 my $pkg = shift; 237*c0c79a3fStz204579 238*c0c79a3fStz204579 return $pkg->{'id'}; 239*c0c79a3fStz204579} 240*c0c79a3fStz204579 241*c0c79a3fStz204579package eventDef; 242*c0c79a3fStz204579 243*c0c79a3fStz204579%uniqueId = (); 244*c0c79a3fStz204579 245*c0c79a3fStz2045791; 246*c0c79a3fStz204579 247*c0c79a3fStz204579sub new { 248*c0c79a3fStz204579 my $pkg = shift; 249*c0c79a3fStz204579 my $id = shift; 250*c0c79a3fStz204579 my $obj = shift; 251*c0c79a3fStz204579 my $super = shift; 252*c0c79a3fStz204579 253*c0c79a3fStz204579 my $omit; 254*c0c79a3fStz204579 my $type; 255*c0c79a3fStz204579 my $header; 256*c0c79a3fStz204579 my $idNo; 257*c0c79a3fStz204579 my $javaToo; 258*c0c79a3fStz204579 my $title = ''; 259*c0c79a3fStz204579 my @program = (); 260*c0c79a3fStz204579 my @see = (); 261*c0c79a3fStz204579 262*c0c79a3fStz204579 $omit = '' unless $omit = $obj->getAttr('omit'); 263*c0c79a3fStz204579 $type = '' unless $type = $obj->getAttr('type'); 264*c0c79a3fStz204579 $header = 0 unless $header = $obj->getAttr('header'); 265*c0c79a3fStz204579 $idNo = '' unless $idNo = $obj->getAttr('idNo'); 266*c0c79a3fStz204579 267*c0c79a3fStz204579 if ($idNo ne '' && $uniqueId{$idNo}) { 268*c0c79a3fStz204579 print STDERR "$uniqueId{$idNo} and $id have the same id ($idNo)\n"; 269*c0c79a3fStz204579 } 270*c0c79a3fStz204579 else { 271*c0c79a3fStz204579 $uniqueId{$idNo} = $id; 272*c0c79a3fStz204579 } 273*c0c79a3fStz204579 274*c0c79a3fStz204579 return bless {'id' => $id, 275*c0c79a3fStz204579 'header' => $header, 276*c0c79a3fStz204579 'idNo' => $idNo, 277*c0c79a3fStz204579 'omit' => $omit, 278*c0c79a3fStz204579 'super' => $super, 279*c0c79a3fStz204579 'type' => $type, 280*c0c79a3fStz204579 'title' => $title, 281*c0c79a3fStz204579 'program' => \@program, 282*c0c79a3fStz204579 'see' => \@see, 283*c0c79a3fStz204579 'external' => 0, 284*c0c79a3fStz204579 'internal' => 0}, $pkg; 285*c0c79a3fStz204579} 286*c0c79a3fStz204579 287*c0c79a3fStz204579# putDef is called at the end of an <event></event> block, so 288*c0c79a3fStz204579# it sees a completed object. 289*c0c79a3fStz204579 290*c0c79a3fStz204579sub putDef { 291*c0c79a3fStz204579 my $pkg = shift; 292*c0c79a3fStz204579 my $obj = shift; # ref to xmlHandlers event object 293*c0c79a3fStz204579 my $context = shift; 294*c0c79a3fStz204579 295*c0c79a3fStz204579 my $id = $pkg->{'id'}; 296*c0c79a3fStz204579 297*c0c79a3fStz204579 if ($context eq 'internal') { 298*c0c79a3fStz204579 $pkg->{$context} = new internalEvent($id, $obj); 299*c0c79a3fStz204579 return undef; 300*c0c79a3fStz204579 } elsif ($context eq 'external') { 301*c0c79a3fStz204579 my $ref = $pkg->{$context} = new externalEvent($id, $obj); 302*c0c79a3fStz204579 return $ref->{'internalName'}; 303*c0c79a3fStz204579 } 304*c0c79a3fStz204579} 305*c0c79a3fStz204579 306*c0c79a3fStz204579sub getId { 307*c0c79a3fStz204579 my $pkg = shift; 308*c0c79a3fStz204579 309*c0c79a3fStz204579 return $pkg->{'id'}; 310*c0c79a3fStz204579} 311*c0c79a3fStz204579 312*c0c79a3fStz204579sub getHeader { 313*c0c79a3fStz204579 my $pkg = shift; 314*c0c79a3fStz204579 315*c0c79a3fStz204579 return $pkg->{'header'}; 316*c0c79a3fStz204579} 317*c0c79a3fStz204579 318*c0c79a3fStz204579sub getIdNo { 319*c0c79a3fStz204579 my $pkg = shift; 320*c0c79a3fStz204579 321*c0c79a3fStz204579 return $pkg->{'idNo'}; 322*c0c79a3fStz204579} 323*c0c79a3fStz204579 324*c0c79a3fStz204579sub getSuperClass { 325*c0c79a3fStz204579 my $pkg = shift; 326*c0c79a3fStz204579 327*c0c79a3fStz204579 return $pkg->{'super'}; 328*c0c79a3fStz204579} 329*c0c79a3fStz204579 330*c0c79a3fStz204579sub getOmit { 331*c0c79a3fStz204579 my $pkg = shift; 332*c0c79a3fStz204579 333*c0c79a3fStz204579 return $pkg->{'omit'}; 334*c0c79a3fStz204579} 335*c0c79a3fStz204579 336*c0c79a3fStz204579sub getType { 337*c0c79a3fStz204579 my $pkg = shift; 338*c0c79a3fStz204579 339*c0c79a3fStz204579 return $pkg->{'type'}; 340*c0c79a3fStz204579} 341*c0c79a3fStz204579 342*c0c79a3fStz204579sub getTitle { 343*c0c79a3fStz204579 return shift->{'title'}; 344*c0c79a3fStz204579} 345*c0c79a3fStz204579 346*c0c79a3fStz204579sub getProgram { 347*c0c79a3fStz204579 return shift->{'program'}; 348*c0c79a3fStz204579} 349*c0c79a3fStz204579 350*c0c79a3fStz204579sub getSee { 351*c0c79a3fStz204579 return shift->{'see'}; 352*c0c79a3fStz204579} 353*c0c79a3fStz204579 354*c0c79a3fStz204579sub getInternal { 355*c0c79a3fStz204579 my $pkg = shift; 356*c0c79a3fStz204579 357*c0c79a3fStz204579 return $pkg->{'internal'}; 358*c0c79a3fStz204579} 359*c0c79a3fStz204579 360*c0c79a3fStz204579sub getExternal { 361*c0c79a3fStz204579 my $pkg = shift; 362*c0c79a3fStz204579 363*c0c79a3fStz204579 return $pkg->{'external'}; 364*c0c79a3fStz204579} 365*c0c79a3fStz204579 366*c0c79a3fStz204579# this isn't fully implemented; just a skeleton 367*c0c79a3fStz204579 368*c0c79a3fStz204579package tokenDef; 369*c0c79a3fStz204579 370*c0c79a3fStz2045791; 371*c0c79a3fStz204579 372*c0c79a3fStz204579sub new { 373*c0c79a3fStz204579 my $pkg = shift; 374*c0c79a3fStz204579 my $obj = shift; 375*c0c79a3fStz204579 my $id = shift; 376*c0c79a3fStz204579 377*c0c79a3fStz204579 $usage = $obj->getAttr('usage'); 378*c0c79a3fStz204579 $usage = '' unless defined $usage; 379*c0c79a3fStz204579 380*c0c79a3fStz204579 return bless {'id' => $id, 381*c0c79a3fStz204579 'usage' => $usage 382*c0c79a3fStz204579 }, $pkg; 383*c0c79a3fStz204579} 384*c0c79a3fStz204579 385*c0c79a3fStz204579sub getId { 386*c0c79a3fStz204579 my $pkg = shift; 387*c0c79a3fStz204579 388*c0c79a3fStz204579 return $pkg->{'id'}; 389*c0c79a3fStz204579} 390*c0c79a3fStz204579 391*c0c79a3fStz204579sub getUsage { 392*c0c79a3fStz204579 my $pkg = shift; 393*c0c79a3fStz204579 394*c0c79a3fStz204579 return $pkg->{'usage'}; 395*c0c79a3fStz204579} 396*c0c79a3fStz204579 397*c0c79a3fStz204579package messageList; 398*c0c79a3fStz204579 399*c0c79a3fStz2045791; 400*c0c79a3fStz204579 401*c0c79a3fStz204579sub new { 402*c0c79a3fStz204579 my $pkg = shift; 403*c0c79a3fStz204579 my $obj = shift; 404*c0c79a3fStz204579 my $id = shift; 405*c0c79a3fStz204579 my $header = shift; 406*c0c79a3fStz204579 my $start = shift; 407*c0c79a3fStz204579 my $public = shift; 408*c0c79a3fStz204579 my $deprecated = shift; 409*c0c79a3fStz204579 410*c0c79a3fStz204579 my @msg = (); 411*c0c79a3fStz204579 412*c0c79a3fStz204579 my @kid = $obj->getKids(); # kids of msg_list are msg 413*c0c79a3fStz204579 my $kid; 414*c0c79a3fStz204579 foreach $kid (@kid) { 415*c0c79a3fStz204579 my $class = $kid->getClass(); 416*c0c79a3fStz204579 if ($class eq 'msg') { 417*c0c79a3fStz204579 my $text = $kid->getContent(); 418*c0c79a3fStz204579 $text = '' unless defined ($text); 419*c0c79a3fStz204579 my $msgId = $kid->getAttr('id'); 420*c0c79a3fStz204579 if (defined ($msgId)) { 421*c0c79a3fStz204579 push(@msg, join('::', $msgId, $text)); 422*c0c79a3fStz204579 } 423*c0c79a3fStz204579 else { 424*c0c79a3fStz204579 print STDERR "missing id for $class <msg>\n"; 425*c0c79a3fStz204579 } 426*c0c79a3fStz204579 } 427*c0c79a3fStz204579 else { 428*c0c79a3fStz204579 print STDERR "invalid tag in <msg_list> block: $class\n"; 429*c0c79a3fStz204579 } 430*c0c79a3fStz204579 } 431*c0c79a3fStz204579 432*c0c79a3fStz204579 return bless {'id' => $id, 433*c0c79a3fStz204579 'header' => $header, 434*c0c79a3fStz204579 'msg' => \@msg, 435*c0c79a3fStz204579 'start' => $start, 436*c0c79a3fStz204579 'public' => $public, 437*c0c79a3fStz204579 'deprecated' => $deprecated 438*c0c79a3fStz204579 }, $pkg; 439*c0c79a3fStz204579} 440*c0c79a3fStz204579 441*c0c79a3fStz204579sub getId { 442*c0c79a3fStz204579 my $pkg = shift; 443*c0c79a3fStz204579 444*c0c79a3fStz204579 return $pkg->{'id'}; 445*c0c79a3fStz204579} 446*c0c79a3fStz204579 447*c0c79a3fStz204579sub getMsgStart { 448*c0c79a3fStz204579 my $pkg = shift; 449*c0c79a3fStz204579 450*c0c79a3fStz204579 return $pkg->{'start'}; 451*c0c79a3fStz204579} 452*c0c79a3fStz204579 453*c0c79a3fStz204579sub getDeprecated { 454*c0c79a3fStz204579 my $pkg = shift; 455*c0c79a3fStz204579 456*c0c79a3fStz204579 return $pkg->{'deprecated'}; 457*c0c79a3fStz204579} 458*c0c79a3fStz204579 459*c0c79a3fStz204579sub getMsgPublic { 460*c0c79a3fStz204579 my $pkg = shift; 461*c0c79a3fStz204579 462*c0c79a3fStz204579 return $pkg->{'public'}; 463*c0c79a3fStz204579} 464*c0c79a3fStz204579 465*c0c79a3fStz204579sub getHeader { 466*c0c79a3fStz204579 my $pkg = shift; 467*c0c79a3fStz204579 468*c0c79a3fStz204579 return $pkg->{'header'}; 469*c0c79a3fStz204579} 470*c0c79a3fStz204579 471*c0c79a3fStz204579# destructive read of @msg... 472*c0c79a3fStz204579 473*c0c79a3fStz204579sub getNextMsg { 474*c0c79a3fStz204579 my $pkg = shift; 475*c0c79a3fStz204579 476*c0c79a3fStz204579 my @msg = @{$pkg->{'msg'}}; 477*c0c79a3fStz204579 478*c0c79a3fStz204579 return undef unless @msg; 479*c0c79a3fStz204579 480*c0c79a3fStz204579 my $text = pop(@msg); 481*c0c79a3fStz204579 $pkg->{'msg'} = \@msg; 482*c0c79a3fStz204579 return $text; 483*c0c79a3fStz204579} 484*c0c79a3fStz204579 485*c0c79a3fStz204579# returns all msgs 486*c0c79a3fStz204579sub getMsgs { 487*c0c79a3fStz204579 my $pkg = shift; 488*c0c79a3fStz204579 489*c0c79a3fStz204579 return @{$pkg->{'msg'}}; 490*c0c79a3fStz204579} 491*c0c79a3fStz204579 492*c0c79a3fStz204579 493*c0c79a3fStz204579package auditxml; 494*c0c79a3fStz204579 495*c0c79a3fStz204579# These aren't internal state because the callback functions don't 496*c0c79a3fStz204579# have the object handle. 497*c0c79a3fStz204579 498*c0c79a3fStz204579@debug = (); # stack for nesting debug state 499*c0c79a3fStz204579%event = (); # event name => $objRef 500*c0c79a3fStz204579@event = (); # event id 501*c0c79a3fStz204579%token = (); # token name => $objRef 502*c0c79a3fStz204579@token = (); # token id 503*c0c79a3fStz204579%msg_list = (); # messageList string list id to obj 504*c0c79a3fStz204579@msg_list = (); # id list 505*c0c79a3fStz204579%service = (); # valid service names 506*c0c79a3fStz204579%externalToInternal = (); # map external event name to internal event name 507*c0c79a3fStz204579 508*c0c79a3fStz2045791; 509*c0c79a3fStz204579 510*c0c79a3fStz204579sub new { 511*c0c79a3fStz204579 my $pkg = shift; 512*c0c79a3fStz204579 my $file = shift; # xml file to be parsed 513*c0c79a3fStz204579 514*c0c79a3fStz204579 register('event', \&eventStart, \&eventEnd); 515*c0c79a3fStz204579 register('entry', 0, \&entry); 516*c0c79a3fStz204579 register('external', 0, \&external); 517*c0c79a3fStz204579 register('internal', 0, \&internal); 518*c0c79a3fStz204579 register('include', 0, \&include); 519*c0c79a3fStz204579 register('token', 0, \&token); 520*c0c79a3fStz204579 register('service', 0, \&service); 521*c0c79a3fStz204579 register('msg_list', 0, \&msg_list); 522*c0c79a3fStz204579 register('msg', 0, \&msg); 523*c0c79a3fStz204579 524*c0c79a3fStz204579 # do not use register() for debug because register generates extra 525*c0c79a3fStz204579 # debug information 526*c0c79a3fStz204579 527*c0c79a3fStz204579 xmlHandlers::registerStartCallback('debug', \&debugStart); 528*c0c79a3fStz204579 xmlHandlers::registerEndCallback('debug', \&debugEnd); 529*c0c79a3fStz204579 530*c0c79a3fStz204579 $xml = new xmlHandlers(0, 'top level', $file); 531*c0c79a3fStz204579 532*c0c79a3fStz204579 return bless {'xmlObj' => $xml, 533*c0c79a3fStz204579 'firstToken' => 1, 534*c0c79a3fStz204579 'firstEvent' => 1}, $pkg; 535*c0c79a3fStz204579} 536*c0c79a3fStz204579 537*c0c79a3fStz204579# local function -- register both the auditxml function and the 538*c0c79a3fStz204579# xmlHandler callback 539*c0c79a3fStz204579 540*c0c79a3fStz204579sub register { 541*c0c79a3fStz204579 my $localName = shift; 542*c0c79a3fStz204579 my $startFunction = shift; 543*c0c79a3fStz204579 my $endFunction = shift; 544*c0c79a3fStz204579 545*c0c79a3fStz204579 if ($startFunction) { 546*c0c79a3fStz204579 xmlHandlers::registerStartCallback($localName, \&completed); 547*c0c79a3fStz204579 $startFunction{$localName} = $startFunction; 548*c0c79a3fStz204579 } 549*c0c79a3fStz204579 if ($endFunction) { 550*c0c79a3fStz204579 xmlHandlers::registerEndCallback($localName, \&completed); 551*c0c79a3fStz204579 $endFunction{$localName} = $endFunction; 552*c0c79a3fStz204579 } 553*c0c79a3fStz204579} 554*c0c79a3fStz204579 555*c0c79a3fStz204579sub completed { 556*c0c79a3fStz204579 my $obj = shift; 557*c0c79a3fStz204579 my $callbackSource = shift; 558*c0c79a3fStz204579 559*c0c79a3fStz204579 my $id = $obj->getAttr('id'); 560*c0c79a3fStz204579 my $class = $obj->getClass(); 561*c0c79a3fStz204579 562*c0c79a3fStz204579 if ($main::debug) { 563*c0c79a3fStz204579 print "*** $callbackSource: $class", (defined ($id)) ? "= $id\n" : "\n"; 564*c0c79a3fStz204579 565*c0c79a3fStz204579 my %attributes = $obj->getAttributes(); 566*c0c79a3fStz204579 my $attribute; 567*c0c79a3fStz204579 foreach $attribute (keys %attributes) { 568*c0c79a3fStz204579 print "*** $attribute = $attributes{$attribute}\n"; 569*c0c79a3fStz204579 } 570*c0c79a3fStz204579 my $content = $obj->getContent(); 571*c0c79a3fStz204579 print "*** content = $content\n" if defined $content; 572*c0c79a3fStz204579 } 573*c0c79a3fStz204579 if ($callbackSource eq 'start') { 574*c0c79a3fStz204579 &{$startFunction{$class}}($obj); 575*c0c79a3fStz204579 } 576*c0c79a3fStz204579 elsif ($callbackSource eq 'end') { 577*c0c79a3fStz204579 &{$endFunction{$class}}($obj); 578*c0c79a3fStz204579 } 579*c0c79a3fStz204579 else { 580*c0c79a3fStz204579 print STDERR "no auditxml function defined for $class\n"; 581*c0c79a3fStz204579 } 582*c0c79a3fStz204579} 583*c0c79a3fStz204579 584*c0c79a3fStz204579# getNextEvent reads from @event destructively. 'firstEvent' could 585*c0c79a3fStz204579# be used to make a copy from which to read. 586*c0c79a3fStz204579 587*c0c79a3fStz204579sub getNextEvent { 588*c0c79a3fStz204579 my $pkg = shift; 589*c0c79a3fStz204579 590*c0c79a3fStz204579 return undef unless (@event); 591*c0c79a3fStz204579 if ($pkg->{'firstEvent'}) { 592*c0c79a3fStz204579 @token = sort @token; 593*c0c79a3fStz204579 $pkg->{'firstEvent'} = 1; 594*c0c79a3fStz204579 } 595*c0c79a3fStz204579 596*c0c79a3fStz204579 my $id = shift @event; 597*c0c79a3fStz204579 598*c0c79a3fStz204579 return $event{$id}; 599*c0c79a3fStz204579} 600*c0c79a3fStz204579 601*c0c79a3fStz204579# returns all event ids 602*c0c79a3fStz204579sub getEventIds { 603*c0c79a3fStz204579 my $pkg = shift; 604*c0c79a3fStz204579 605*c0c79a3fStz204579 return @event; 606*c0c79a3fStz204579} 607*c0c79a3fStz204579 608*c0c79a3fStz204579# returns event for id 609*c0c79a3fStz204579sub getEvent { 610*c0c79a3fStz204579 my $pkg = shift; 611*c0c79a3fStz204579 my $id = shift; 612*c0c79a3fStz204579 613*c0c79a3fStz204579 return $event{$id}; 614*c0c79a3fStz204579} 615*c0c79a3fStz204579 616*c0c79a3fStz204579sub getToken { 617*c0c79a3fStz204579 my $pkg = shift; 618*c0c79a3fStz204579 my $id = shift; 619*c0c79a3fStz204579 620*c0c79a3fStz204579 return $token{$id}; 621*c0c79a3fStz204579} 622*c0c79a3fStz204579 623*c0c79a3fStz204579# getNextToken reads from @token destructively. 'firstToken' could 624*c0c79a3fStz204579# be used to make a copy from which to read. 625*c0c79a3fStz204579 626*c0c79a3fStz204579sub getNextToken { 627*c0c79a3fStz204579 my $pkg = shift; 628*c0c79a3fStz204579 629*c0c79a3fStz204579 return undef unless (@token); 630*c0c79a3fStz204579 631*c0c79a3fStz204579 if ($pkg->{'firstToken'}) { 632*c0c79a3fStz204579 @token = sort @token; 633*c0c79a3fStz204579 $pkg->{'firstToken'} = 1; 634*c0c79a3fStz204579 } 635*c0c79a3fStz204579 my $id = shift @token; 636*c0c79a3fStz204579 637*c0c79a3fStz204579 return $token{$id}; 638*c0c79a3fStz204579} 639*c0c79a3fStz204579 640*c0c79a3fStz204579# return token Ids 641*c0c79a3fStz204579 642*c0c79a3fStz204579sub getTokenIds { 643*c0c79a3fStz204579 my $pkg = shift; 644*c0c79a3fStz204579 645*c0c79a3fStz204579 return @token; 646*c0c79a3fStz204579} 647*c0c79a3fStz204579 648*c0c79a3fStz204579# getNextMsgId reads from @msg_list destructively. 649*c0c79a3fStz204579 650*c0c79a3fStz204579sub getNextMsgId { 651*c0c79a3fStz204579 my $pkg = shift; 652*c0c79a3fStz204579 653*c0c79a3fStz204579 return undef unless (@msg_list); 654*c0c79a3fStz204579 655*c0c79a3fStz204579 my $id = shift @msg_list; 656*c0c79a3fStz204579 657*c0c79a3fStz204579 return ($id, $msg_list{$id}); 658*c0c79a3fStz204579} 659*c0c79a3fStz204579 660*c0c79a3fStz204579sub getMsgIds { 661*c0c79a3fStz204579 my $pkg = shift; 662*c0c79a3fStz204579 663*c0c79a3fStz204579 return @msg_list; 664*c0c79a3fStz204579} 665*c0c79a3fStz204579 666*c0c79a3fStz204579sub getMsg { 667*c0c79a3fStz204579 my $pkg = shift; 668*c0c79a3fStz204579 my $id = shift; 669*c0c79a3fStz204579 670*c0c79a3fStz204579 return $msg_list{$id}; 671*c0c79a3fStz204579} 672*c0c79a3fStz204579 673*c0c79a3fStz204579sub external { 674*c0c79a3fStz204579} 675*c0c79a3fStz204579 676*c0c79a3fStz204579sub internal { 677*c0c79a3fStz204579 678*c0c79a3fStz204579} 679*c0c79a3fStz204579 680*c0c79a3fStz204579sub eventStart { 681*c0c79a3fStz204579 my $obj = shift; 682*c0c79a3fStz204579 683*c0c79a3fStz204579 my $id = $obj->getAttr('id'); 684*c0c79a3fStz204579 685*c0c79a3fStz204579 unless ($id) { 686*c0c79a3fStz204579 print STDERR "eventStart can't get a valid id\n"; 687*c0c79a3fStz204579 return; 688*c0c79a3fStz204579 } 689*c0c79a3fStz204579 unless (defined $event{$id}) { 690*c0c79a3fStz204579 my $super; 691*c0c79a3fStz204579 if ($super = $obj->getAttr('instance_of')) { 692*c0c79a3fStz204579 $super = $event{$super}; 693*c0c79a3fStz204579 } else { 694*c0c79a3fStz204579 $super = 0; 695*c0c79a3fStz204579 } 696*c0c79a3fStz204579 $event{$id} = new eventDef($id, $obj, $super); 697*c0c79a3fStz204579 push (@event, $id); 698*c0c79a3fStz204579 } else { 699*c0c79a3fStz204579 print STDERR "duplicate event id: $id\n"; 700*c0c79a3fStz204579 } 701*c0c79a3fStz204579} 702*c0c79a3fStz204579 703*c0c79a3fStz204579sub eventEnd { 704*c0c79a3fStz204579 my $obj = shift; 705*c0c79a3fStz204579 706*c0c79a3fStz204579 my $id = $obj->getAttr('id'); 707*c0c79a3fStz204579 unless (defined $id) { 708*c0c79a3fStz204579 print STDERR "event element is missing required id attribute\n"; 709*c0c79a3fStz204579 return; 710*c0c79a3fStz204579 } 711*c0c79a3fStz204579 print "event = $id\n" if $main::debug; 712*c0c79a3fStz204579 713*c0c79a3fStz204579 foreach my $kid ($obj->getKids) { 714*c0c79a3fStz204579 my $class = $kid->getClass; 715*c0c79a3fStz204579 next unless ($class =~ /title|program|see/); 716*c0c79a3fStz204579 my $content = $kid->getContent; 717*c0c79a3fStz204579 if ($class eq 'title') { 718*c0c79a3fStz204579 $event{$id}->{$class} = $content; 719*c0c79a3fStz204579 } else { 720*c0c79a3fStz204579 push @{$event{$id}->{$class}}, $content; 721*c0c79a3fStz204579 } 722*c0c79a3fStz204579 } 723*c0c79a3fStz204579 $event{$id}->putDef($obj, 'internal'); 724*c0c79a3fStz204579 725*c0c79a3fStz204579 my $internalName = $event{$id}->putDef($obj, 'external'); 726*c0c79a3fStz204579 727*c0c79a3fStz204579 $externalToInternal{$id} = $internalName if $internalName; 728*c0c79a3fStz204579} 729*c0c79a3fStz204579 730*c0c79a3fStz204579# class method 731*c0c79a3fStz204579 732*c0c79a3fStz204579#sub getInternalName { 733*c0c79a3fStz204579# my $name = shift; 734*c0c79a3fStz204579# 735*c0c79a3fStz204579# return $externalToInternal{$name}; 736*c0c79a3fStz204579#} 737*c0c79a3fStz204579 738*c0c79a3fStz204579sub entry { 739*c0c79a3fStz204579} 740*c0c79a3fStz204579 741*c0c79a3fStz204579#sub include { 742*c0c79a3fStz204579# my $obj = shift; 743*c0c79a3fStz204579# 744*c0c79a3fStz204579# my $id = $obj->getAttr('id'); 745*c0c79a3fStz204579# 746*c0c79a3fStz204579# if (defined $id) { 747*c0c79a3fStz204579# print "include = $id\n" if $main::debug; 748*c0c79a3fStz204579# } 749*c0c79a3fStz204579# else { 750*c0c79a3fStz204579# print STDERR "include element is missing required id attribute\n"; 751*c0c79a3fStz204579# } 752*c0c79a3fStz204579#} 753*c0c79a3fStz204579 754*c0c79a3fStz204579sub token { 755*c0c79a3fStz204579 my $obj = shift; 756*c0c79a3fStz204579 757*c0c79a3fStz204579 my $id = $obj->getAttr('id'); 758*c0c79a3fStz204579 759*c0c79a3fStz204579 if (defined $id) { 760*c0c79a3fStz204579 print "token = $id\n" if $main::debug; 761*c0c79a3fStz204579 $token{$id} = new tokenDef($obj, $id); 762*c0c79a3fStz204579 push (@token, $id); 763*c0c79a3fStz204579 } 764*c0c79a3fStz204579 else { 765*c0c79a3fStz204579 print STDERR "token element is missing required id attribute\n"; 766*c0c79a3fStz204579 } 767*c0c79a3fStz204579} 768*c0c79a3fStz204579 769*c0c79a3fStz204579sub msg_list { 770*c0c79a3fStz204579 my $obj = shift; 771*c0c79a3fStz204579 772*c0c79a3fStz204579 my $id = $obj->getAttr('id'); 773*c0c79a3fStz204579 my $header = $obj->getAttr('header'); 774*c0c79a3fStz204579 my $start = $obj->getAttr('start'); 775*c0c79a3fStz204579 my $public = $obj->getAttr('public'); 776*c0c79a3fStz204579 my $deprecated = $obj->getAttr('deprecated'); 777*c0c79a3fStz204579 778*c0c79a3fStz204579 $header = 0 unless $header; 779*c0c79a3fStz204579 $start = 0 unless $start; 780*c0c79a3fStz204579 $public = ($public) ? 1 : 0; 781*c0c79a3fStz204579 $deprecated = ($deprecated) ? 1 : 0; 782*c0c79a3fStz204579 783*c0c79a3fStz204579 if (defined $id) { 784*c0c79a3fStz204579 print "msg_list = $id\n" if $main::debug; 785*c0c79a3fStz204579 $msg_list{$id} = new messageList($obj, $id, $header, $start, 786*c0c79a3fStz204579 $public, $deprecated); 787*c0c79a3fStz204579 push (@msg_list, $id); 788*c0c79a3fStz204579 } 789*c0c79a3fStz204579 else { 790*c0c79a3fStz204579 print STDERR 791*c0c79a3fStz204579 "msg_list element is missing required id attribute\n"; 792*c0c79a3fStz204579 } 793*c0c79a3fStz204579} 794*c0c79a3fStz204579 795*c0c79a3fStz204579sub msg { 796*c0c79a3fStz204579# my $obj = shift; 797*c0c79a3fStz204579} 798*c0c79a3fStz204579 799*c0c79a3fStz204579# Service name was dropped during PSARC review 800*c0c79a3fStz204579 801*c0c79a3fStz204579sub service { 802*c0c79a3fStz204579 my $obj = shift; 803*c0c79a3fStz204579 804*c0c79a3fStz204579 my $name = $obj->getAttr('name'); 805*c0c79a3fStz204579 my $id = $obj->getAttr('id'); 806*c0c79a3fStz204579 807*c0c79a3fStz204579 if ((defined $id) && (defined $name)) { 808*c0c79a3fStz204579 print "service $name = $id\n" if $main::debug; 809*c0c79a3fStz204579 $service{$name} = $id; 810*c0c79a3fStz204579 } 811*c0c79a3fStz204579 elsif (defined $name) { 812*c0c79a3fStz204579 print STDERR "service $name is missing an id number\n"; 813*c0c79a3fStz204579 } 814*c0c79a3fStz204579 elsif (defined $id) { 815*c0c79a3fStz204579 print STDERR "service name missing for id = $id\n"; 816*c0c79a3fStz204579 } 817*c0c79a3fStz204579 else { 818*c0c79a3fStz204579 print STDERR "missing both name and id for a service entry\n"; 819*c0c79a3fStz204579 } 820*c0c79a3fStz204579} 821*c0c79a3fStz204579 822*c0c79a3fStz204579#sub getServices { 823*c0c79a3fStz204579# 824*c0c79a3fStz204579# return %service; 825*c0c79a3fStz204579#} 826*c0c79a3fStz204579 827*c0c79a3fStz204579# <debug set="on"> or <debug set="off"> or <debug> 828*c0c79a3fStz204579# if the set attribute is omitted, debug state is toggled 829*c0c79a3fStz204579 830*c0c79a3fStz204579# debugStart / debugEnd are used to insure debug state is 831*c0c79a3fStz204579# scoped to the block between <debug> and </debug> 832*c0c79a3fStz204579 833*c0c79a3fStz204579sub debugStart { 834*c0c79a3fStz204579 my $obj = shift; 835*c0c79a3fStz204579 836*c0c79a3fStz204579 push (@debug, $main::debug); 837*c0c79a3fStz204579 my $debug = $main::debug; 838*c0c79a3fStz204579 839*c0c79a3fStz204579 my $state = $obj->getAttr('set'); 840*c0c79a3fStz204579 841*c0c79a3fStz204579 if (defined $state) { 842*c0c79a3fStz204579 $main::debug = ($state eq 'on') ? 1 : 0; 843*c0c79a3fStz204579 } 844*c0c79a3fStz204579 else { 845*c0c79a3fStz204579 $main::debug = !$debug; 846*c0c79a3fStz204579 } 847*c0c79a3fStz204579 if ($debug != $main::debug) { 848*c0c79a3fStz204579 print 'debug is ', $main::debug ? 'on' : 'off', "\n"; 849*c0c79a3fStz204579 } 850*c0c79a3fStz204579} 851*c0c79a3fStz204579 852*c0c79a3fStz204579sub debugEnd { 853*c0c79a3fStz204579 my $obj = shift; 854*c0c79a3fStz204579 855*c0c79a3fStz204579 my $debug = $main::debug; 856*c0c79a3fStz204579 $main::debug = pop (@debug); 857*c0c79a3fStz204579 858*c0c79a3fStz204579 if ($debug != $main::debug) { 859*c0c79a3fStz204579 print 'debug is ', $main::debug ? 'on' : 'off', "\n"; 860*c0c79a3fStz204579 } 861*c0c79a3fStz204579} 862