SGMLS.pm

   1 package SGMLS;
   2 use Carp;
   3
   4 $version = '$Revision: 1.14 $';
   5
   6 =head1 NAME
   7
   8 SGMLS - class for postprocessing the output from the B<sgmls> and
   9 B<nsgmls> parsers.
  10
  11 =head1 SYNOPSIS
  12
  13   use SGMLS;
  14
  15   my $parse = new SGMLS(STDIN);
  16
  17   my $event = $parse->next_event;
  18   while ($event) {
  19
  20     SWITCH: {
  21
  22       ($event->type eq 'start_element') && do {
  23         my $element = $event->data;    # An object of class SGMLS_Element
  24         [[your code for the beginning of an element]]
  25         last SWITCH;
  26       };
  27
  28       ($event->type eq 'end_element') && do {
  29         my $element = $event->data;    # An object of class SGMLS_Element
  30         [[your code for the end of an element]]
  31         last SWITCH;
  32       };
  33
  34       ($event->type eq 'cdata') && do {
  35         my $cdata = $event->data;      # A string
  36         [[your code for character data]]
  37         last SWITCH;
  38       };
  39
  40       ($event->type eq 'sdata') && do {
  41         my $sdata = $event->data;      # A string
  42         [[your code for system data]]
  43         last SWITCH;
  44       };
  45
  46       ($event->type eq 're') && do {
  47         [[your code for a record end]]
  48         last SWITCH;
  49       };
  50
  51       ($event->type eq 'pi') && do {
  52         my $pi = $event->data;         # A string
  53         [[your code for a processing instruction]]
  54         last SWITCH;
  55       };
  56
  57       ($event->type eq 'entity') && do {
  58         my $entity = $event->data;     # An object of class SGMLS_Entity
  59         [[your code for an external entity]]
  60         last SWITCH;
  61       };
  62
  63       ($event->type eq 'start_subdoc') && do {
  64         my $entity = $event->data;     # An object of class SGMLS_Entity
  65         [[your code for the beginning of a subdoc entity]]
  66         last SWITCH;
  67       };
  68
  69       ($event->type eq 'end_subdoc') && do {
  70         my $entity = $event->data;     # An object of class SGMLS_Entity
  71         [[your code for the end of a subdoc entity]]
  72         last SWITCH;
  73       };
  74
  75       ($event->type eq 'conforming') && do {
  76         [[your code for a conforming document]]
  77         last SWITCH;
  78       };
  79
  80       die "Internal error: unknown event type " . $event->type . "\n";
  81     }
  82
  83     $event = $parse->next_event;
  84   }
  85
  86 =head1 DESCRIPTION
  87
  88 The B<SGMLS> package consists of several related classes: see
  89 L<"SGMLS">, L<"SGMLS_Event">, L<"SGMLS_Element">,
  90 L<"SGMLS_Attribute">, L<"SGMLS_Notation">, and L<"SGMLS_Entity">.  All
  91 of these classes are available when you specify
  92
  93   use SGMLS;
  94
  95 Generally, the only object which you will create explicitly will
  96 belong to the C<SGMLS> class; all of the others will then be created
  97 automatically for you over the course of the parse.  Much fuller
  98 documentation is available in the C<.sgml> files in the C<DOC/>
  99 directory of the C<SGMLS.pm> distribution.
 100
 101 =head2 The C<SGMLS> class
 102
 103 This class holds a single parse.  When you create an instance of it,
 104 you specify a file handle as an argument (if you are reading the
 105 output of B<sgmls> or B<nsgmls> from a pipe, the file handle will
 106 ordinarily be C<STDIN>):
 107
 108   my $parse = new SGMLS(STDIN);
 109
 110 The most important method for this class is C<next_event>, which reads
 111 and returns the next major event from the input stream.  It is
 112 important to note that the C<SGMLS> class deals with most B<ESIS>
 113 events itself: attributes and entity definitions, for example, are
 114 collected and stored automatically and invisibly to the user.  The
 115 following list contains all of the methods for the C<SGMLS> class:
 116
 117 =item C<next_event()>: Return an C<SGMLS_Event> object containing the
 118 next major event from the SGML parse.
 119
 120 =item C<element()>: Return an C<SGMLS_Element> object containing the
 121 current element in the document.
 122
 123 =item C<file()>: Return a string containing the name of the current
 124 SGML source file (this will work only if the C<-l> option was given to
 125 B<sgmls> or B<nsgmls>).
 126
 127 =item C<line()>: Return a string containing the current line number
 128 from the source file (this will work only if the C<-l> option was
 129 given to B<sgmls> or B<nsgmls>).
 130
 131 =item C<appinfo()>: Return a string containing the C<APPINFO>
 132 parameter (if any) from the SGML declaration.
 133
 134 =item C<notation(NNAME)>: Return an C<SGMLS_Notation> object
 135 representing the notation named C<NNAME>.  With newer versions of
 136 B<nsgmls>, all notations are available; otherwise, only the notations
 137 which are actually used will be available.
 138
 139 =item C<entity(ENAME)>: Return an C<SGMLS_Entity> object representing
 140 the entity named C<ENAME>.  With newer versions of B<nsgmls>, all
 141 entities are available; otherwise, only external data entities and
 142 internal entities used as attribute values will be available.
 143
 144 =item C<ext()>: Return a reference to an associative array for
 145 user-defined extensions.
 146
 147
 148 =head2 The C<SGMLS_Event> class
 149
 150 This class holds a single major event, as generated by the
 151 C<next_event> method in the C<SGMLS> class.  It uses the following
 152 methods:
 153
 154 =item C<type()>: Return a string describing the type of event:
 155 "start_element", "end_element", "cdata", "sdata", "re", "pi",
 156 "entity", "start_subdoc", "end_subdoc", and "conforming".  See
 157 L<"SYNOPSIS">, above, for the values associated with each of these.
 158
 159 =item C<data()>: Return the data associated with the current event (if
 160 any).  For "start_element" and "end_element", returns an
 161 C<SGMLS_ELement> object; for "entity", "start_subdoc", and
 162 "end_subdoc", returns an C<SGMLS_Entity> object; for "cdata", "sdata",
 163 and "pi", returns a string; and for "re" and "conforming", returns the
 164 empty string.  See L<"SYNOPSIS">, above, for an example of this
 165 method's use.
 166
 167 =item C<key()>: Return a string key to the event, such as an element
 168 or entity name (otherwise, the same as C<data()>).
 169
 170 =item C<file()>: Return the current file name, as in the C<SGMLS>
 171 class.
 172
 173 =item C<line()>: Return the current line number, as in the C<SGMLS>
 174 class.
 175
 176 =item C<element()>: Return the current element, as in the C<SGMLS>
 177 class.
 178
 179 =item C<parse()>: Return the C<SGMLS> object which generated the
 180 event.
 181
 182 =item C<entity(ENAME)>: Look up an entity, as in the C<SGMLS> class.
 183
 184 =item C<notation(ENAME)>: Look up a notation, as in the C<SGMLS>
 185 class.
 186
 187 =item C<ext()>: Return a reference to an associative array for
 188 user-defined extensions.
 189
 190
 191 =head2 The C<SGMLS_Element> class
 192
 193 This class is used for elements, and contains all associated
 194 information (such as the element's attributes).  It recognises the
 195 following methods:
 196
 197 =item C<name()>: Return a string containing the name, or Generic
 198 Identifier, of the element, in upper case.
 199
 200 =item C<parent()>: Return the C<SGMLS_Element> object for the
 201 element's parent (if any).
 202
 203 =item C<parse()>: Return the C<SGMLS> object for the current parse.
 204
 205 =item C<attributes()>: Return a reference to an associative array of
 206 attribute names and C<SGMLS_Attribute> structures.  Attribute names
 207 will be all in upper case.
 208
 209 =item C<attribute_names()>: Return an array of strings containing the
 210 names of all attributes defined for the current element, in upper
 211 case.
 212
 213 =item C<attribute(ANAME)>: Return the C<SGMLS_Attribute> structure for
 214 the attribute C<ANAME>.
 215
 216 =item C<set_attribute(ATTRIB)>: Add the C<SGMLS_Attribute> object
 217 C<ATTRIB> to the current element, replacing any other attribute
 218 structure with the same name.
 219
 220 =item C<in(GI)>: Return C<true> (ie. 1) if the string C<GI> is the
 221 name of the current element's parent, or C<false> (ie. 0) if it is
 222 not.
 223
 224 =item C<within(GI)>: Return C<true> (ie. 1) if the string C<GI> is the
 225 name of any of the ancestors of the current element, or C<false>
 226 (ie. 0) if it is not.
 227
 228 =item C<ext()>: Return a reference to an associative array for
 229 user-defined extensions.
 230
 231
 232 =head2 The C<SGMLS_Attribute> class
 233
 234 Each instance of an attribute for each C<SGMLS_Element> is an object
 235 belonging to this class, which recognises the following methods:
 236
 237 =item C<name()>: Return a string containing the name of the current
 238 attribute, all in upper case.
 239
 240 =item C<type()>: Return a string containing the type of the current
 241 attribute, all in upper case.  Available types are "IMPLIED", "CDATA",
 242 "NOTATION", "ENTITY", and "TOKEN".
 243
 244 =item C<value()>: Return the value of the current attribute, if any.
 245 This will be an empty string if the type is "IMPLIED", a string of
 246 some sort if the type is "CDATA" or "TOKEN" (if it is "TOKEN", you may
 247 want to split the string into a series of separate tokens), an
 248 C<SGMLS_Notation> object if the type is "NOTATION", or an
 249 C<SGMLS_Entity> object if the type is "ENTITY".  Note that if the
 250 value is "CDATA", it will I<not> have escape sequences for 8-bit
 251 characters, record ends, or SDATA processed -- that will be your
 252 responsibility.
 253
 254 =item C<is_implied()>: Return C<true> (ie. 1) if the value of the
 255 attribute is implied, or C<false> (ie. 0) if it is specified in the
 256 document.
 257
 258 =item C<set_type(TYPE)>: Change the type of the attribute to the
 259 string C<TYPE> (which should be all in upper case).  Available types
 260 are "IMPLIED", "CDATA", "NOTATION", "ENTITY", and "TOKEN".
 261
 262 =item C<set_value(VALUE)>: Change the value of the attribute to
 263 C<VALUE>, which may be a string, an C<SGMLS_Entity> object, or an
 264 C<SGMLS_Notation> subject, depending on the attribute's type.
 265
 266 =item C<ext()>: Return a reference to an associative array available
 267 for user-defined extensions.
 268
 269
 270 =head2 The C<SGMLS_Notation> class
 271
 272 All declared notations appear as objects belonging to this class,
 273 which recognises the following methods:
 274
 275 =item C<name()>: Return a string containing the name of the notation.
 276
 277 =item C<sysid()>: Return a string containing the system identifier of
 278 the notation, if any.
 279
 280 =item C<pubid()>: Return a string containing the public identifier of
 281 the notation, if any.
 282
 283 =item C<ext()>: Return a reference to an associative array available
 284 for user-defined extensions.
 285
 286
 287 =head2 The C<SGMLS_Entity> class
 288
 289 All declared entities appear as objects belonging to this class, which
 290 recognises the following methods:
 291
 292 =item C<name()>: Return a string containing the name of the entity, in
 293 mixed case.
 294
 295 =item C<type()>: Return a string containing the type of the entity, in
 296 upper case.  Available types are "CDATA", "SDATA", "NDATA" (external
 297 entities only), "SUBDOC", "PI" (newer versions of B<nsgmls> only), or
 298 "TEXT" (newer versions of B<nsgmls> only).
 299
 300 =item C<value()>: Return a string containing the value of the entity,
 301 if it is internal.
 302
 303 =item C<sysid()>: Return a string containing the system identifier of
 304 the entity (if any), if it is external.
 305
 306 =item C<pubid()>: Return a string containing the public identifier of
 307 the entity (if any), if it is external.
 308
 309 =item C<filenames()>: Return an array of strings containing any file
 310 names generated from the identifiers, if the entity is external.
 311
 312 =item C<notation()>: Return the C<SGMLS_Notation> object associated
 313 with the entity, if it is external.
 314
 315 =item C<data_attributes()>: Return a reference to an associative array
 316 of data attribute names (in upper case) and the associated
 317 C<SGMLS_Attribute> objects for the current entity.
 318
 319 =item C<data_attribute_names()>: Return an array of data attribute
 320 names (in upper case) for the current entity.
 321
 322 =item C<data_attribute(ANAME)>: Return the C<SGMLS_Attribute> object
 323 for the data attribute named C<ANAME> for the current entity.
 324
 325 =item C<set_data_attribute(ATTRIB)>: Add the C<SGMLS_Attribute> object
 326 C<ATTRIB> to the current entity, replacing any other data attribute
 327 with the same name.
 328
 329 =item C<ext()>: Return a reference to an associative array for
 330 user-defined extensions.
 331
 332
 333 =head1 AUTHOR AND COPYRIGHT
 334
 335 Copyright 1994 and 1995 by David Megginson,
 336 C<dmeggins@aix1.uottawa.ca>.  Distributed under the terms of the Gnu
 337 General Public License (version 2, 1991) -- see the file C<COPYING>
 338 which is included in the B<SGMLS.pm> distribution.
 339
 340
 341 =head1 SEE ALSO:
 342
 343 L<SGMLS::Output> and L<SGMLS::Refs>.
 344
 345 =cut
 346
 347 #
 348 # Data class for a single SGMLS ESIS output event.  The object will
 349 # keep information about its own current element and, if available,
 350 # the source file and line where the event appeared.
 351 #
 352 # Event types are as follow:
 353 #        Event                 Data
 354 # -------------------------------------------------------
 355 #     'start_element'        SGMLS_Element
 356 #     'end_element'          SGMLS_Element
 357 #     'cdata'                string
 358 #     'sdata'                string
 359 #     're'                   [none]
 360 #     'pi'                   string
 361 #     'entity'               SGMLS_Entity
 362 #     'start_subdoc'         SGMLS_Entity
 363 #     'end_subdoc'           SGMLS_Entity
 364 #     'conforming'           [none]
 365 #
 366 package SGMLS_Event;
 367 use Carp;
 368                                 # Constructor.
 369 sub new {
 370     my ($class,$type,$data,$parse) = @_;
 371     return bless [$type,
 372                   $data,
 373                   $parse->file,
 374                   $parse->line,
 375                   $parse->element,
 376                   $parse,
 377                   {}
 378                   ];
 379 }
 380                                 # Accessors.
 381 sub type { return $_[0]->[0]; }
 382 sub data { return $_[0]->[1]; }
 383 sub file { return $_[0]->[2]; }
 384 sub line { return $_[0]->[3]; }
 385 sub element { return $_[0]->[4]; }
 386 sub parse { return $_[0]->[5]; }
 387 sub ext { return $_[0]->[6]; }
 388                                 # Generate a key for the event.
 389 sub key {
 390     my $self = shift;
 391     if (ref($self->data) eq SGMLS_Element ||
 392         ref($self->data) eq SGMLS_Entity) {
 393         return $self->data->name;
 394     } else {
 395         return $self->data;
 396     }
 397 }
 398                                 # Look up an entity in the parse.
 399 sub entity {
 400     my ($self,$ename) = (@_);
 401     return $self->parse->entity($ename);
 402 }
 403                                 # Look up a notation in the parse.
 404 sub notation {
 405     my ($self,$nname) = (@_);
 406     return $self->parse->notation($nname);
 407 }
 408
 409
 410 #
 411 # Data class for a single SGML attribute.  The object will know its
 412 # type, and will keep a value unless the type is 'IMPLIED', in which
 413 # case no meaningful value is available.
 414 #
 415 # Attribute types are as follow:
 416 #      Type                    Value
 417 # ---------------------------------------
 418 #     IMPLIED                 [none]
 419 #     CDATA                   string
 420 #     NOTATION                SGMLS_Notation
 421 #     ENTITY                  SGMLS_Entity
 422 #     TOKEN                   string
 423 #
 424 package SGMLS_Attribute;
 425 use Carp;
 426                                 # Constructor.
 427 sub new {
 428     my ($class,$name,$type,$value) = @_;
 429     return bless [$name,$type,$value,{}];
 430 }
 431                                 # Accessors.
 432 sub name { return $_[0]->[0]; }
 433 sub type { return $_[0]->[1]; }
 434 sub value { return $_[0]->[2]; }
 435 sub ext { return $_[0]->[3]; }
 436                                 # Return 1 if the value is implied.
 437 sub is_implied {
 438     my $self = shift;
 439     return ($self->type eq 'IMPLIED');
 440 }
 441                                 # Set the attribute's type.
 442 sub set_type {
 443     my ($self,$type) = @_;
 444     $self->[1] = $type;
 445 }
 446
 447                                 # Set the attribute's value.
 448 sub set_value {
 449     my ($self,$value) = @_;
 450     $self->[2] = $value;
 451 }
 452
 453
 454 #
 455 # Data class for a single element of an SGML document.  The object will not
 456 # know about its children (data or other elements), but it keeps track of its
 457 # parent and its attributes.
 458 #
 459 package SGMLS_Element;
 460 use Carp;
 461                                 # Constructor.
 462 sub new {
 463     my ($class,$name,$parent,$attributes,$parse) = @_;
 464     return bless [$name,$parent,$attributes,$parse,{}];
 465 }
 466                                 # Accessors.
 467 sub name { return $_[0]->[0]; }
 468 sub parent { return $_[0]->[1]; }
 469 sub parse { return $_[0]->[3]; }
 470 sub ext { return $_[0]->[4]; }
 471
 472                                 # Return the associative array of
 473                                 # attributes, parsing it the first
 474                                 # time through.
 475 sub attributes {
 476     my $self = shift;
 477     if (ref($self->[2]) eq 'ARRAY') {
 478         my $new = {};
 479         foreach (@{$self->[2]}) {
 480             /^(\S+) (IMPLIED|CDATA|NOTATION|ENTITY|TOKEN)( (.*))?$/
 481                 || croak "Bad attribute event data: $_";
 482             my ($name,$type,$value) = ($1,$2,$4);
 483             if ($type eq 'NOTATION') {
 484                 $value = $self->parse->notation($value);
 485             } elsif ($type eq 'ENTITY') {
 486                 $value = $self->parse->entity($value);
 487             }
 488             $new->{$name} =
 489                 new SGMLS_Attribute($name,$type,$value);
 490         }
 491         $self->[2] = $new;
 492     }
 493     return $self->[2];
 494 }
 495                                 # Return a list of attribute names.
 496 sub attribute_names {
 497     my $self = shift;
 498     return keys(%{$self->attributes});
 499 }
 500                                 # Find an attribute by name.
 501 sub attribute {
 502     my ($self,$aname) = @_;
 503     return $self->attributes->{$aname};
 504 }
 505                                 # Add a new attribute.
 506 sub set_attribute {
 507     my ($self,$attribute) = @_;
 508     $self->attributes->{$attribute->name} = $attribute;
 509 }
 510                                 # Check parent by name.
 511 sub in {
 512     my ($self,$name) = @_;
 513     if ($self->parent && $self->parent->name eq $name) {
 514         return $self->parent;
 515     } else {
 516         return '';
 517     }
 518 }
 519                                 # Check ancestors by name.
 520 sub within {
 521     my ($self,$name) = @_;
 522     for ($self = $self->parent; $self; $self = $self->parent) {
 523         return $self if ($self->name eq $name);
 524     }
 525     return '';
 526 }
 527
 528
 529 #
 530 # Data class for an SGML notation.  The only information available
 531 # will be the name, the sysid, and the pubid -- the rest is up to the
 532 # processing application.
 533 #
 534 package SGMLS_Notation;
 535 use Carp;
 536                                 # Constructor.
 537 sub new {
 538     my ($class,$name,$sysid,$pubid) = @_;
 539     return bless [$name,$sysid,$pubid,{}];
 540 }
 541                                 # Accessors.
 542 sub name { return $_[0]->[0]; }
 543 sub sysid { return $_[0]->[1]; }
 544 sub pubid { return $_[0]->[2]; }
 545 sub ext { return $_[0]->[3]; }
 546
 547 #
 548 # Data class for a single SGML entity.  All entities will have a name
 549 # and a type.  Internal entities will be of type CDATA or SDATA only,
 550 # and will have a value rather than a notation and sysid/pubid.  External
 551 # CDATA, NDATA, and SDATA entities will always have notations attached,
 552 # and SUBDOC entities are always external (and will be parsed by SGMLS).
 553 #
 554 # Entity types are as follow:
 555 #      Type     Internal    External
 556 # -----------------------------------------------------------
 557 #     CDATA      x           x
 558 #     NDATA                  x
 559 #     SDATA      x           x
 560 #     SUBDOC                 x
 561 # (newer versions of NSGMLS only:)
 562 #     PI         x
 563 #     TEXT       x           x
 564 #
 565 package SGMLS_Entity;
 566 use Carp;
 567                                 # Constructor.
 568 sub new {
 569     my ($class,$name,$type,$value,$sysid,$pubid,$filenames,$notation) = @_;
 570     return bless [$name,$type,$value,{},$sysid,$pubid,$filenames,$notation,{}];
 571 }
 572                                 # Accessors.
 573 sub name { return $_[0]->[0]; }
 574 sub type { return $_[0]->[1]; }
 575 sub value { return $_[0]->[2]; }
 576 sub data_attributes { return $_[0]->[3]; }
 577 sub sysid { return $_[0]->[4]; }
 578 sub pubid { return $_[0]->[5]; }
 579 sub filenames { return $_[0]->[6]; }
 580 sub notation { return $_[0]->[7]; }
 581 sub ext { return $_[0]->[8]; }
 582                                 # Return a list of data-attribute names.
 583 sub data_attribute_names {
 584     my $self = shift;
 585     return keys(%{$self->data_attributes});
 586 }
 587                                 # Find a data attribute by name.
 588 sub data_attribute {
 589     my ($self,$aname) = @_;
 590     return $self->data_attributes->{$aname};
 591 }
 592                                 # Add a new data attribute.
 593 sub set_data_attribute {
 594     my ($self,$data_attribute) = @_;
 595     $self->data_attributes()->{$data_attribute->name} = $data_attribute;
 596 }
 597
 598
 599
 600 #
 601 # Data class for a single SGMLS parse.  The constructor takes a single
 602 # argument, a file handle from which the SGMLS ESIS events will be read
 603 # (it may be a pipe, a fifo, a file, a socket, etc.).  It is essential
 604 # that no two SGMLS objects have the same handle.
 605 #
 606 package SGMLS;
 607                                 # Constructor.
 608 sub new {
 609     my ($class,$handle) = @_;
 610
 611     # Force unqualified filehandles into caller's package
 612     my ($package) = caller;
 613     $handle =~ s/^[^':]+$/$package\:\:$&/;
 614
 615     return bless {
 616         'handle' => $handle,
 617         'event_stack' => [],
 618         'current_element' => '',
 619         'current_attributes' => [],
 620         'current_entities' => {},
 621         'entity_stack' => [],
 622         'current_notations' => {},
 623         'notation_stack' => [],
 624         'current_sysid' => '',
 625         'current_pubid' => '',
 626         'current_filenames' => [],
 627         'current_file' => '',
 628         'current_line' => '',
 629         'appinfo' => '',
 630         'ext' => {}
 631         };
 632 }
 633                                 # Accessors.
 634 sub element { return $_[0]->{'current_element'}; }
 635 sub file { return $_[0]->{'current_file'}; }
 636 sub line { return $_[0]->{'current_line'}; }
 637 sub appinfo { return $_[0]->{'appinfo'}; }
 638 sub ext { return $_[0]->{'ext'}; }
 639
 640                                 # Given its name, look up a notation.
 641 sub notation {
 642     my ($self,$nname) = @_;
 643     return $self->{'current_notations'}->{$nname};
 644 }
 645                                 # Given its name, look up an entity.
 646 sub entity {
 647     my ($self,$ename) = @_;
 648     return $self->{'current_entities'}->{$ename};
 649 }
 650
 651                                 # Return the next SGMLS_Event, or ''
 652                                 # if the document has finished.
 653 sub next_event {
 654     my $self = shift;
 655     my $handle = $self->{'handle'};
 656
 657                                 # If there are any queued up events,
 658                                 # grab them first.
 659     if ($#{$self->{event_stack}} >= 0) {
 660         return pop @{$self->{event_stack}};
 661     }
 662
 663   dispatch: while (!eof($handle)) {
 664
 665       my $c = getc($handle);
 666       my $data = <$handle>;
 667       chop $data;
 668
 669       ($c eq '(') && do {       # start an element
 670           $self->{'current_element'} =
 671               new SGMLS_Element($data,
 672                                 $self->{'current_element'},
 673                                 $self->{'current_attributes'},
 674                                 $self);
 675           $self->{'current_attributes'} = [];
 676           return new SGMLS_Event('start_element',
 677                                  $self->{'current_element'},
 678                                  $self);
 679       };
 680
 681       ($c eq ')') && do {       # end an element
 682           my $old = $self->{'current_element'};
 683           $self->{'current_element'} = $self->{'current_element'}->parent;
 684           return new SGMLS_Event('end_element',$old,$self);
 685       };
 686
 687       ($c eq '-') && do {       # some data
 688           my $sdata_flag = 0;
 689           my $out = '';
 690           while ($data =~ /\\(\\|n|\||[0-7]{1,3})/) {
 691               $out .= $`;
 692               $data = $';
 693                                 # beginning or end of SDATA
 694               if ($1 eq '|') {
 695                   if ("$out" ne '') {
 696                       unshift(@{$self->{'event_stack'}},
 697                               new SGMLS_Event($sdata_flag?'sdata':'cdata',
 698                                               $out,
 699                                               $self));
 700                       $out = '';
 701                   }
 702                   $sdata_flag = !$sdata_flag;
 703                                 # record end
 704               } elsif ($1 eq 'n') {
 705                   if ("$out" ne '') {
 706                       unshift(@{$self->{'event_stack'}},
 707                               new SGMLS_Event($sdata_flag?'sdata':'cdata',
 708                                               $out,
 709                                               $self));
 710                       $out = '';
 711                   }
 712                   unshift(@{$self->{'event_stack'}},
 713                           new SGMLS_Event('re','',$self));
 714               } elsif ($1 eq '\\') {
 715                   $out .= '\\';
 716               } else {
 717                   $out .= chr(oct($1));
 718               }
 719           }
 720           $out .= $data;
 721           if ("$out" ne '') {
 722               unshift(@{$self->{'event_stack'}},
 723                       new SGMLS_Event($sdata_flag?'sdata':'cdata',
 724                                       $out,
 725                                       $self));
 726           }
 727               return $self->next_event;
 728       };
 729
 730       ($c eq '&') && do {       # external entity reference
 731           return new SGMLS_Event('entity',
 732                                  ($self->{'current_entities'}->{$data}
 733                                   || croak "Unknown external entity: $data\n"),
 734                                  $self);
 735       };
 736
 737       ($c eq '?') && do {       # processing instruction
 738           return new SGMLS_Event('pi',
 739                                  $data,
 740                                  $self);
 741       };
 742
 743       ($c eq 'A') && do {       # attribute declaration
 744                                 # (will parse only on demand)
 745           push @{$self->{'current_attributes'}}, $data;
 746           next dispatch;
 747       };
 748
 749       ($c eq 'a') && do {       # link attribute declaration
 750           # NOT YET IMPLEMENTED!
 751           next dispatch;
 752       };
 753
 754       ($c eq 'D') && do {       # data attribute declaration
 755           $data =~ /^(\S+) (\S+) (\S+)( (.*))?$/
 756             || croak "Bad data-attribute event data: $data";
 757           my ($ename,$aname,$type,$value) = ($1,$2,$3,$5);
 758           my $entity = $self->{'current_entities'}->{$ename};
 759           my $attribute = new SGMLS_Attribute($aname,$type,$value);
 760           $entity->set_data_attribute($attribute);
 761           next dispatch;
 762       };
 763
 764       ($c eq 'N') && do {       # notation declaration
 765           $self->{'current_notations'}->{$data} =
 766               new SGMLS_Notation($data,
 767                                  $self->{'current_sysid'},
 768                                  $self->{'current_pubid'});
 769           $self->{'current_sysid'} = '';
 770           $self->{'current_pubid'} = '';
 771           next dispatch;
 772       };
 773
 774       ($c eq 'E') && do {       # external entity declaration
 775           $data =~ /^(\S+) (\S+) (\S+)$/
 776               || croak "Bad external entity event data: $data";
 777           my ($name,$type,$nname) = ($1,$2,$3);
 778           my $notation = $self->{'current_notations'}->{$nname} if $nname;
 779           $self->{'current_entities'}->{$name} =
 780               new SGMLS_Entity($name,
 781                                $type,
 782                                '',
 783                                $self->{'current_sysid'},
 784                                $self->{'current_pubid'},
 785                                $self->{'current_filenames'},
 786                                $notation);
 787           $self->{'current_sysid'} = '';
 788           $self->{'current_pubid'} = '';
 789           $self->{'current_filenames'} = [];
 790           next dispatch;
 791       };
 792
 793       ($c eq 'I') && do {       # internal entity declaration
 794           $data =~ /^(\S+) (\S+) (.*)$/
 795               || croak "Bad external entity event data: $data";
 796           my ($name,$type,$value) = ($1,$2,$3);
 797           $self->{'current_entities'}->{$name} =
 798               new SGMLS_Entity($name, $type, $value);
 799           next dispatch;
 800       };
 801
 802       ($c eq 'T') && do {       # external text entity declaration
 803           $self->{'current_entities'}->{$data} =
 804               new SGMLS_Entity($data,
 805                                'TEXT',
 806                                '',
 807                                $self->{'current_sysid'},
 808                                $self->{'current_pubid'},
 809                                $self->{'current_filenames'},
 810                                '');
 811           $self->{'current_sysid'} = '';
 812           $self->{'current_pubid'} = '';
 813           $self->{'current_filenames'} = [];
 814           next dispatch;
 815       };
 816
 817       ($c eq 'S') && do {       # subdocument entity declaration
 818           $self->{'current_entities'}->{$data} =
 819               new SGMLS_Entity($data,
 820                                'SUBDOC',
 821                                '',
 822                                $self->{'current_sysid'},
 823                                $self->{'current_pubid'},
 824                                $self->{'current_filenames'},
 825                                '');
 826           $self->{'current_sysid'} = '';
 827           $self->{'current_pubid'} = '';
 828           $self->{'current_filenames'} = [];
 829           next dispatch;
 830       };
 831
 832       ($c eq 's') && do {       # system id
 833           $self->{'current_sysid'} = $data;
 834           next dispatch;
 835       };
 836
 837       ($c eq 'p') && do {       # public id
 838           $self->{'current_pubid'} = $data;
 839           next dispatch;
 840       };
 841
 842       ($c eq 'f') && do {       # generated filename
 843           push @{$self->{'current_filenames'}}, $data;
 844           next dispatch;
 845       };
 846
 847       ($c eq '{') && do {       # begin subdocument entity
 848           my $subdoc = ($self->{'current_entities'}->{$data}||
 849                         croak "Unknown SUBDOC entity $data\n");
 850           push @{$self->{'notation_stack'}}, $self->{'current_notations'};
 851           push @{$self->{'entity_stack'}}, $self->{'current_entities'};
 852           $self->{'current_notations'} = {};
 853           $self->{'current_entities'} = {};
 854           return new SGMLS_Event('start_subdoc',
 855                                  $subdoc,
 856                                  $self);
 857       };
 858
 859       ($c eq '}') && do {       # end subdocument entity
 860           $self->{'current_notations'} = pop @{$self->{'notation_stack'}};
 861           $self->{'current_entities'} = pop @{$self->{'entity_stack'}};
 862           return new SGMLS_Event('end_subdoc',
 863                                  ($self->{'current_entities'}->{$data} ||
 864                                   croak "Unknown SUBDOC entity $data\n"),
 865                                  $self);
 866       };
 867
 868       ($c eq 'L') && do {       # line number (and file name)
 869           $data =~ /^(\d+)( (.*))?$/;
 870           $self->{'current_line'} = $1;
 871           $self->{'current_file'} = $3 if $3;
 872           next dispatch;
 873       };
 874
 875       ($c eq '#') && do {       # APPINFO parameter
 876           $self->{'appinfo'} = $data;
 877           next dispatch;
 878       };
 879
 880       ($c eq 'C') && do {       # document is conforming
 881           return new SGMLS_Event('conforming','',$self);
 882       };
 883   }
 884     return '';
 885 }
 886
 887 1;
 888
 889 ########################################################################
 890 # Local Variables:
 891 # mode: perl
 892 # End:
 893 ########################################################################