1: #!/usr/bin/perl -w
  2: package SGML::ElementMap::Example::Identity;
  3: use strict;

  5: use vars qw($trace $is_sgml);
  6: $trace = 0;
  7: $is_sgml = 0;


 10: sub Initialize {
 11:     my ($engine,$outfile) = @_;

 13:     InstallHandlers($engine);
 14:     #$engine->mode_set('DEFAULT');
 15:     $engine->stack->default_cascade;

 17:     if ($trace) {
 18:         select STDERR; $| = 1;
 19:         select STDOUT; $| = 1;
 20:         #Hash::Layered->trace;
 21:         #$engine->debug('general','element_path','handler_lookup','modes');
 22:         #                         'stack'
 23:         #$engine->debug('visitors');
 24:     }
 25: }


 28: sub InstallHandlers {
 29:     my ($sgml) = @_;
 30:     $sgml->cdata  ('',\&Identity_CData);
 31:     $sgml->sdata  ('',\&Identity_Entity);
 32:     $sgml->entity ('',\&Identity_Entity);
 33:     $sgml->pi     ('',\&Identity_PI);
 34:     $sgml->comment('',\&Identity_Comment);
 35:     $sgml->element('',\&Identity_Element);
 36: }

 38: sub Identity_CData {
 39:     my ($sgml,$data) = @_;
 40:     $data = $data->{'Data'};
 41:     #my @tmp = split '&',$data; #cant do this until can detect cdata sections
 42:     #$data = join '&',@tmp;
 43:     #$data =~ s/\</\&lt;/g;
 44:     print $data;
 45: }

 47: sub Identity_Entity {
 48:     my ($sgml,$data) = @_;
 49:     warn "[".join('][',%$data)."]\n" if $trace;
 50:     print "&".$data->{'Name'}.";";
 51: }

 53: sub Identity_Comment {
 54:     my ($sgml,$comment) = @_;
 55:     print "<!--".$comment->{'Data'}."-->";
 56: }

 58: sub Identity_PI {
 59:     my ($sgml,$data) = @_;
 60:     if ($is_sgml) {
 61:         print "<?".$data->{'Data'}.">";
 62:     } else {
 63:         #exists $data->{'Target'}
 64:         print "<?".$data->{'Target'}." ".$data->{'Data'}."?>";
 65:     }
 66: }

 68: sub Identity_Element {
 69:     my ($sgml,$element) = @_;
 70:     my ($atts,$att,$attname,$val,@order,$lastattr);

 72:     print "<" . $element->{'Name'};

 74:     $atts = $element->{'Attributes'};
 75:     $lastattr = '';
 76:     if (defined $element->{'AttributeOrder'}) {
 77:         @order = @{$element->{'AttributeOrder'}};
 78:         if ($element->{'Defaulted'} < @order) {
 79:             $lastattr = $order[$element->{'Defaulted'}];
 80:         }
 81:         if (@order > 0) {
 82:             warn "$element->{Name}:$element->{Defaulted}:".join(':',@order)."\n" if $trace;
 83:         }
 84:     } else {
 85:         @order = sort keys %$atts;
 86:     }

 88:     foreach $attname (@order) {
 89:         last if $attname eq $lastattr;
 90:         #need to test for specified attributes, attrs with entities, etc
 91:         $att = $$atts{$attname};
 92:         if (!defined $att) {
 93:             warn "value undefined for attribute $attname\n";
 94:         } elsif (ref $att) {
 95:             print " ".$attname.'="';
 96:             foreach my $seg (@$att) {
 97:                 if (ref $seg) {
 98:                     print '&' . $seg->name . ';';
 99:                 } else {
100:                     print $seg;
101:                 }
102:             }
103:             print '"';
104:         } else {
105:             print " ".$attname.'="'.$att.'"';
106:         }
107:     }

109:     print "\n>";

111:     $sgml->process_content;

113:     #need to test for empty element
114:     print "</".$element->{'Name'}."\n>";
115: }

117: 1;