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