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