—

              
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Std;
use XML::SAX::ParserFactory;
use IO::File;
use Data::Dumper;
use POSIX qw(ctime);
my %opts;
getopts('p:', \%opts);
my $rules = new Rules();
my $parser = new XML::SAX::ParserFactory->parser(Handler => $rules);
my $infile;
if ($opts{p}) {
    $infile = $opts{p};
}
else {
    use WAP::wbxml;
    my $path = $INC{'WAP/wbxml.pm'};
    $path =~ s/\.pm$//i;
    $infile = $path . '/wap.wbrules.xml';
}
my $io = new IO::File($infile, 'r');
die "Can't open $infile ($!).\n"
        unless (defined $io);
$parser->parse_file($io);
delete $rules->{app_curr};
delete $rules->{ext_curr};
my $d = Data::Dumper->new([$rules], [qw(rules)]);
#$d->Indent(1);
$d->Indent(0);
my $outfile = 'wbrules2.pl';
open my $OUT, '>', $outfile
        or die "Can't open $outfile ($!).\n";
print $OUT "# This file is generated by mkwbrules. DO NOT modify it.\n";
print $OUT "# From file : ",$infile,"\n";
print $OUT "# Generation date : ",POSIX::ctime(time());
print $OUT $d->Dump();
close $OUT;
HideShow 7 lines of Pod
=pod
This script `mkwbrules' builds the file `wap.wbrules2.pl' from the installed file
`WAP/wap.wbrules.xml' that describes rules of the binarization (module WAP::wbxml).
=cut
package Rules;      # SAX handler
sub new {
    my $class = shift;
    my $self = {};
    bless($self,$class);
    return $self;
}
sub start_element {
    my $self = shift;
    my ($element) = @_;
    my $name = $element->{Name};
    my $attrs = $element->{Attributes};
    if ($name eq 'PublicIdentifier') {
        # <!ELEMENT PublicIdentifier EMPTY>
        # <!ATTLIST PublicIdentifier value NMTOKEN #REQUIRED>
        # <!ATTLIST PublicIdentifier name CDATA #REQUIRED>
        $self->{PublicIdentifier}{hex $attrs->{'{}value'}->{Value}} = $attrs->{'{}name'}->{Value};
    }
    elsif ($name eq 'App') {
        # <!ELEMENT App (wbxml:TagTokens,AttrStartTokens,AttrValueTokens)>
        # <!ATTLIST App publicid CDATA #REQUIRED>
        # <!ATTLIST App systemid CDATA #IMPLIED>
        # <!ATTLIST App use-default (no|yes) #IMPLIED>
        # <!ATTLIST App variable-subs (no|yes) #IMPLIED>
        # <!ATTLIST App textual-ext NMTOKEN #IMPLIED>
        # <!ATTLIST App tokenised-ext NMTOKEN #IMPLIED>
        # <!ATTLIST App xml-space (default|preserve) #IMPLIED>
        my $publicid = $attrs->{'{}publicid'}->{Value};
        $self->{app_curr} = $publicid;
        $self->{App}{$publicid} = bless({},'App');
        $self->{App}{$publicid}->{variable_subs} = $attrs->{'{}variable-subs'}->{Value}
                if (        exists $attrs->{'{}variable-subs'}
                        and $attrs->{'{}variable-subs'}->{Value} eq 'yes' );
        $self->{App}{$publicid}->{systemid} = $attrs->{'{}systemid'}->{Value}
                if (exists $attrs->{'{}systemid'});
    }
    elsif ($name eq 'TAG') {
        # <!ELEMENT TAG EMPTY>
        # <!ATTLIST TAG token NMTOKEN #REQUIRED>
        # <!ATTLIST TAG name NMTOKEN #REQUIRED>
        # <!ATTLIST TAG codepage NMTOKEN #IMPLIED>
        # <!ATTLIST TAG encoding (integer|datetime) #IMPLIED>
        my $token = hex $attrs->{'{}token'}->{Value};
        $token += 256 * hex $attrs->{'{}codepage'}->{Value}
                if (exists $attrs->{'{}codepage'});
        $self->{App}{$self->{app_curr}}->{TAG}{$token} = $attrs->{'{}name'}->{Value};
        $self->{App}{$self->{app_curr}}->{TagEncoding}{$token} = $attrs->{'{}encoding'}->{Value}
                if (exists $attrs->{'{}encoding'});
    }
    elsif ($name eq 'ATTRSTART') {
        # <!ELEMENT ATTRSTART EMPTY>
        # <!ATTLIST ATTRSTART token NMTOKEN #REQUIRED>
        # <!ATTLIST ATTRSTART name NMTOKEN #REQUIRED>
        # <!ATTLIST ATTRSTART value CDATA #IMPLIED>
        # <!ATTLIST ATTRSTART codepage NMTOKEN #IMPLIED>
        # <!ATTLIST ATTRSTART default CDATA #IMPLIED>
        # <!ATTLIST ATTRSTART fixed CDATA #IMPLIED>
        # <!ATTLIST ATTRSTART validate (std|length|vdata) #IMPLIED>
        # <!ATTLIST ATTRSTART encoding (std|iso-8601) #IMPLIED>
        my $token = hex $attrs->{'{}token'}->{Value};
        $token += 256 * hex $attrs->{'{}codepage'}->{Value}
                if (exists $attrs->{'{}codepage'});
        $self->{App}{$self->{app_curr}}->{ATTRSTART}{$token} = {};
        $self->{App}{$self->{app_curr}}->{ATTRSTART}{$token}{name} = $attrs->{'{}name'}->{Value};
        $self->{App}{$self->{app_curr}}->{ATTRSTART}{$token}{value} = $attrs->{'{}value'}->{Value}
                if (exists $attrs->{'{}value'});
        $self->{App}{$self->{app_curr}}->{ATTRSTART}{$token}{validate} = $attrs->{'{}validate'}->{Value}
                if (exists $attrs->{'{}validate'});
        $self->{App}{$self->{app_curr}}->{ATTRSTART}{$token}{encoding} = $attrs->{'{}encoding'}->{Value}
                if (exists $attrs->{'{}encoding'});
    }
    elsif ($name eq 'ATTRVALUE') {
        # <!ELEMENT ATTRVALUE EMPTY>
        # <!ATTLIST ATTRVALUE token NMTOKEN #REQUIRED>
        # <!ATTLIST ATTRVALUE value CDATA #REQUIRED>
        # <!ATTLIST ATTRVALUE codepage NMTOKEN #IMPLIED>
        my $token = hex $attrs->{'{}token'}->{Value};
        $token += 256 * hex $attrs->{'{}codepage'}->{Value}
                if (exists $attrs->{'{}codepage'});
        $self->{App}{$self->{app_curr}}->{ATTRVALUE}{$token} = $attrs->{'{}value'}->{Value};
    }
    elsif ($name =~ /(Ext[0-2]Value)s/) {
        $self->{ext_curr} = uc $1;
    }
    elsif ($name eq 'EXTVALUE') {
        # <!ELEMENT EXTVALUE EMPTY>
        # <!ATTLIST EXTVALUE index NMTOKEN #REQUIRED>
        # <!ATTLIST EXTVALUE value CDATA #REQUIRED>
        my $index = hex $attrs->{'{}index'}->{Value};
        $self->{App}{$self->{app_curr}}->{$self->{ext_curr}}{$index} = $attrs->{'{}value'}->{Value};
    }
}