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