#
# WAP::SAXDriver::wbxml
#

package WAP::SAXDriver::wbxml;

use strict;
use warnings;

use base qw(XML::SAX::Base);
use IO::File;
use IO::String;

our $VERSION = '2.07';

sub _parse_characterstream {
    my $p       = shift;
    my $xml     = shift;
    my $opt     = $p->{ParseOptions};

    $p->_init_parser($opt);
    die __PACKAGE__,": Not an IO::Handle\n"
            unless ($xml->isa('IO::Handle'));
    $p->{io_handle} = $xml;
    my $result = $p->_parse($opt);
    $p->_cleanup;
    return $result;
}

sub _parse_bytestream {
    my $p       = shift;
    my $xml     = shift;
    my $opt     = $p->{ParseOptions};

    $p->_init_parser($opt);
    die __PACKAGE__,": Not an IO::Handle\n"
            unless ($xml->isa('IO::Handle'));
    $p->{io_handle} = $xml;
    my $result = $p->_parse($opt);
    $p->_cleanup;
    return $result;
}

sub _parse_string {
    my $p       = shift;
    my $xml     = shift;
    my $opt     = $p->{ParseOptions};

    $p->_init_parser($opt);
    $p->{io_handle} = new IO::String($xml);
    my $result = $p->_parse($opt);
    $p->_cleanup;
    return $result;
}

sub _parse_systemid {
    my $p       = shift;
    my $xml     = shift;
    my $opt     = $p->{ParseOptions};

    $p->_init_parser($opt);
    $p->{io_handle} = new IO::File($xml, 'r');
    die "Can't open $xml ($!)\n"
            unless (defined $p->{io_handle});
    binmode $p->{io_handle}, ':raw';
    my $result = $p->_parse($opt);
    $p->_cleanup;
    return $result;
}

our ($default_rules, $rules);

sub _init_parser {
    my $self = shift;
    my $opt  = shift;

    die __PACKAGE__,": parser instance ($self) already parsing\n"
            if defined $self->{_InParse};

    $self->{_InParse} = 1;

    if ($opt->{UseOnlyDefaultRules}) {
        $self->{Rules} = undef;
    }
    else {
        unless (defined $rules) {
            my $infile;
            if ($opt->{RulesPath}) {
                $infile = $opt->{RulesPath};
            }
            else {
                my $path = $INC{'WAP/SAXDriver/wbxml.pm'};
                $path =~ s/\.pm$//i;
                $infile = $path . '/wap.wbrules2.pl';
            }
            require $infile;
        }
        $self->{Rules} = $rules;
    }
}


sub _cleanup {
    my $self = shift;

    $self->{_InParse} = 0;
    delete $self->{PublicId};
    delete $self->{Encoding};
    delete $self->{App};
    delete $self->{publicid_idx};
    delete $self->{root_name};
    delete $self->{io_strtbl} if (exists $self->{io_strtbl});
    delete $self->{strtbl} if (exists $self->{strtbl});
    delete $self->{io_handle};
}

sub location {
    my $self = shift;

    my $pos = $self->{io_handle}->tell();

    my @properties = (
        ColumnNumber    => $pos,
        LineNumber      => 1,
        BytePosition    => $pos,
    );

    push (@properties, PublicId => $self->{PublicId})
            if (defined $self->{PublicId});

    return { @properties };
}

################################# W B X M L ##################################

use integer;

# Global tokens
use constant SWITCH_PAGE    => 0x00;
use constant _END           => 0x01;
use constant ENTITY         => 0x02;
use constant STR_I          => 0x03;
use constant LITERAL        => 0x04;
use constant EXT_I_0        => 0x40;
use constant EXT_I_1        => 0x41;
use constant EXT_I_2        => 0x42;
use constant PI             => 0x43;
use constant LITERAL_C      => 0x44;
use constant EXT_T_0        => 0x80;
use constant EXT_T_1        => 0x81;
use constant EXT_T_2        => 0x82;
use constant STR_T          => 0x83;
use constant LITERAL_A      => 0x84;
use constant EXT_0          => 0xC0;
use constant EXT_1          => 0xC1;
use constant EXT_2          => 0xC2;
use constant OPAQUE         => 0xC3;
use constant LITERAL_AC     => 0xC4;
# Global token masks
use constant NULL           => 0x00;
use constant HAS_CHILD      => 0x40;
use constant HAS_ATTR       => 0x80;
use constant TAG_MASK       => 0x3F;
use constant ATTR_MASK      => 0x7F;

sub _parse {
    my $self = shift;
    my ($opt) = @_;

    $self->{PublicId} = undef;
    $self->{Encoding} = undef;
    $self->{App} = undef;

    my $version = $self->get_version();
    $self->get_publicid();
    $self->get_charset();
    if (        !defined $self->{Encoding}
            and exists $opt->{Source}{Encoding} ) {
        $self->{Encoding} = $self->{Source}{Encoding};
    }
    $self->get_strtbl();
    $self->{PublicId} = $self->get_str_t($self->{publicid_idx})
            if (exists $self->{publicid_idx});
    if ($self->{PublicId} eq 'PublicId-Unknown') {
        my ($val) = values %{$self->{Rules}->{App}};
        $self->{App} = $val;
    }
    else {
        $self->{App} = $self->{Rules}->{App}{$self->{PublicId}};
    }

    $self->SUPER::start_document( {
            Version         => '1.0',
            Encoding        => $self->{Encoding},
            Standalone      => undef,
            VersionWBXML    => $version,
    } );
    $self->SUPER::xml_decl( {
            Version         => '1.0',
            Encoding        => $self->{Encoding},
            Standalone      => undef,
            VersionWBXML    => $version,
    } );

    my $rc = $self->body();
    my $end = $self->SUPER::end_document( { } );

    unless (defined $rc) {
        my $pos = $self->{io_handle}->tell();
        $self->SUPER::fatal_error( {
                Message         => q{},
                PublicId        => $self->{PublicId},
                ColumnNumber    => $pos,
                LineNumber      => 1,
                BytePosition    => $pos
        } );
        warn __PACKAGE__,": Fatal error at position $pos\n";
    }

    return $end;
}

sub getmb32 {
    my $self = shift;
    my $byte;
    my $val = 0;
    my $nb = 0;
    do {
        $nb ++;
        return undef unless ($nb < 6);
        my $ch = $self->{io_handle}->getc();
        return undef unless (defined $ch);
        $byte = ord $ch;
        $val <<= 7;
        $val += ($byte & 0x7f);
    }
    while (0 != ($byte & 0x80));
    return $val
}

sub get_version {
    my $self = shift;
    my $ch = $self->{io_handle}->getc();
    return undef unless (defined $ch);
    my $v = ord $ch;
    return (1 + $v / 16) . '.' . ($v % 16);
}

sub get_publicid {
    my $self = shift;
    my $publicid = $self->getmb32();
    return undef unless (defined $publicid);
    if ($publicid == 1) {
        $self->{PublicId} = "PublicId-Unknown";
    }
    elsif ($publicid) {
        if (exists $self->{Rules}->{PublicIdentifier}{$publicid}) {
            $self->{PublicId} = $self->{Rules}->{PublicIdentifier}{$publicid};
        }
        else {
            $self->warning("PublicId-$publicid unreferenced");
            $self->{PublicId} = "PublicId-$publicid";
        }
    }
    else {
        $self->{publicid_idx} = $self->getmb32();
    }
}

sub get_charset {
    my $self = shift;
    my $charset = $self->getmb32();
    return unless (defined $charset);
    if ($charset != 0) {
        my $default_charset = {
        # here, only built-in encodings of Expat.
        # MIBenum   =>  iana name
            3       => 'ANSI_X3.4-1968',    # US-ASCII
            4       => 'ISO_8859-1:1987',
            106     => 'UTF-8',
        };
        if (exists $default_charset->{$charset}) {
            $self->{Encoding} = $default_charset->{$charset};
            return;
        }
        eval "use I18N::Charset";
        unless ($@) {
            if (defined I18N::Charset::mib_to_charset_name($charset)) {
                $self->{Encoding} = I18N::Charset::mib_to_charset_name($charset);
                return;
            }
        }
        $self->{Encoding} = "MIBenum-$charset";
        $self->warning("$self->{Encoding} unreferenced");
    }
}

sub get_strtbl {
    my $self = shift;
    my $len = $self->getmb32();
    if ($len) {
        my $str = q{};
        $self->{io_handle}->read($str,$len);
        $self->{strtbl} = $str . chr 0;
        $self->{io_strtbl} = new IO::String($self->{strtbl});
    }
}

sub get_str_t {
    my $self = shift;
    my ($idx) = @_;
    return undef unless (defined $idx);
    return undef unless (exists $self->{io_strtbl});
    $self->{io_strtbl}->setpos($idx);
    my $str = q{};
    my $ch = $self->{io_strtbl}->getc();
    return undef unless (defined $ch);
    while (ord $ch != 0) {
        $str .= $ch;
        $ch = $self->{io_strtbl}->getc();
        return undef unless (defined $ch);
    }
    return $str;
}

sub body {
    my $self = shift;
    my $rc;
    $self->{codepage_tag} = 0;
    $self->{codepage_attr} = 0;
    my $tag = $self->get_tag();
    while ($tag == PI) {
        $rc = $self->pi();
        return undef unless (defined $rc);
        $tag = $self->get_tag();
    }
    $rc = $self->element($tag);
    return undef unless (defined $rc);
    $tag = $self->get_tag();
    if (defined $tag) {
        while ($tag == PI) {
            $rc = $self->pi();
            return undef unless (defined $rc);
            $tag = $self->get_tag();
        }
    }
    return 1;
}

sub pi {
    my $self = shift;
    my $attr = $self->get_attr();
    my $rc = $self->attribute($attr);
    return undef unless (defined $rc);
    my $target = $self->{attrs};
    $attr = $self->get_attr();
    my $data = q{};
    while ($attr != _END) {
        $rc = $self->attribute($attr);
        return undef unless (defined $rc);
        $data .= $self->{attrv};
        $attr = $self->get_attr();
    }
    delete $self->{attrs};
    delete $self->{attrv};
    $self->SUPER::processing_instruction( {
            Target      => $target,
            Data        => $data
    } );
    return 1;
}

sub element {
    my $self = shift;
    my ($tag) = @_;

    return undef unless (defined $tag);
    my $token = $tag & TAG_MASK;
    my $name;
    if ($token == LITERAL) {
        my $idx = $self->getmb32();
        $name = $self->get_str_t($idx);
        return undef unless (defined $name);
    }
    else {
        $token += 256 * $self->{codepage_tag};
        if (        defined $self->{App}
                and exists $self->{App}{TAG}{$token}) {
            $name = $self->{App}{TAG}{$token};
        }
        else {
            $name = "TAG-$token";
            $self->warning("$name unreferenced");
        }
    }
    unless (exists $self->{root_name}) {
        if ($self->{PublicId} ne 'PublicId-Unknown') {
            my $system_id = $self->{App}->{systemid} || $name . '.dtd';
            $self->SUPER::start_dtd( {
                    Name            => $name,
                    PublicId        => $self->{PublicId},
                    SystemId        => $system_id
            } );
            $self->SUPER::end_dtd( { } );
        }
        $self->{root_name} = $name;
    }
    my %saxattr;
    if ($tag & HAS_ATTR) {
        my $attr = $self->get_attr();
        while ($attr != _END) {
            my $rc = $self->attribute($attr);
            return undef unless (defined $rc);
            if (exists $self->{attrs}) {
                my $lname = $self->{attrs};
                my $at = {
                        Name        => $lname,
                        Value       => $self->{attrv}
                };
                $saxattr{"{}$lname"} = $at;
            }
            $attr = $self->get_attr();
        }
        delete $self->{attrs};
        delete $self->{attrv};
    }
    $self->SUPER::start_element( {
            Name        => $name,
            Attributes  => \%saxattr
    } );
    if ($tag & HAS_CHILD) {
        while ((my $child = $self->get_tag()) != _END) {
            my $rc = $self->content($child,$token);
            return undef unless (defined $rc);
        }
    }
    $self->SUPER::end_element( {
            Name        => $name
    } );
    return 1;
}

sub content {
    my $self = shift;
    my ($tag,$parent) = @_;

    return undef unless (defined $tag);
    if      ($tag == ENTITY) {
        my $entcode = $self->getmb32();
        return undef unless (defined $entcode);
        $self->SUPER::characters( {
                Data => chr $entcode
        } );
    }
    elsif ($tag == STR_I) {
        my $string = $self->get_str_i();
        return undef unless (defined $string);
        if (        defined $self->{App}
                and exists $self->{App}{variable_subs} ) {
            $string =~ s/\$/\$\$/g;
        }
        $self->SUPER::characters( {
                Data => $string
        } );
    }
    elsif ($tag == EXT_I_0) {
        my $string = $self->get_str_i();
        return undef unless (defined $string);
        if (        defined $self->{App}
                and exists $self->{App}{variable_subs} ) {
            $self->SUPER::characters( {
                    Data => "\$($string:escape)"
            } );
        }
        else {
            $self->error("EXT_I_0 unexpected");
        }
    }
    elsif ($tag == EXT_I_1) {
        my $string = $self->get_str_i();
        return undef unless (defined $string);
        if (        defined $self->{App}
                and exists $self->{App}{variable_subs} ) {
            $self->SUPER::characters( {
                Data => "\$($string:unesc)"
            } );
        }
        else {
            $self->error("EXT_I_1 unexpected");
        }
    }
    elsif ($tag == EXT_I_2) {
        my $string = $self->get_str_i();
        return undef unless (defined $string);
        if (        defined $self->{App}
                and exists $self->{App}{variable_subs} ) {
            $self->SUPER::characters( {
                Data => "\$($string)"
            } );
        }
        else {
            $self->error("EXT_I_2 unexpected");
        }
    }
    elsif ($tag == PI) {
        my $rc = $self->pi();
        return undef unless (defined $rc);
    }
    elsif ($tag == EXT_T_0) {
        my $idx = $self->getmb32();
        if (        defined $self->{App}
                and exists $self->{App}{variable_subs} ) {
            my $string = $self->get_str_t($idx);
            return undef unless (defined $string);
            $self->SUPER::characters( {
                    Data => "\$($string:escape)"
            } );
        }
        elsif (   defined $self->{App}
                and exists $self->{App}{EXT0VALUE}) {
            if (exists $self->{App}{EXT0VALUE}{$idx}) {
                $self->SUPER::characters( {
                        Data => $self->{App}{EXT0VALUE}{$idx}
                } );
            }
            else {
                $self->error("EXT_T_0 $idx unknown");
            }
        }
        else {
            $self->error("EXT_T_0 unexpected");
        }
    }
    elsif ($tag == EXT_T_1) {
        my $idx = $self->getmb32();
        if (        defined $self->{App}
                and exists $self->{App}{variable_subs} ) {
            my $string = $self->get_str_t($idx);
            return undef unless (defined $string);
            $self->SUPER::characters( {
                Data => "\$($string:unesc)"
            } );
        }
        elsif (   defined $self->{App}
                and exists $self->{App}{EXT1VALUE}) {
            if (exists $self->{App}{EXT1VALUE}{$idx}) {
                $self->SUPER::characters( {
                        Data => $self->{App}{EXT1VALUE}{$idx}
                } );
            }
            else {
                $self->error("EXT_T_1 $idx unknown");
            }
        }
        else {
            $self->error("EXT_T_1 unexpected");
        }
    }
    elsif ($tag == EXT_T_2) {
        my $idx = $self->getmb32();
        if (        defined $self->{App}
                and exists $self->{App}{variable_subs} ) {
            my $string = $self->get_str_t($idx);
            return undef unless (defined $string);
            $self->SUPER::characters( {
                Data => "\$($string)"
            } );
        }
        elsif (   defined $self->{App}
                and exists $self->{App}{EXT2VALUE}) {
            if (exists $self->{App}{EXT2VALUE}{$idx}) {
                $self->SUPER::characters( {
                        Data => $self->{App}{EXT2VALUE}{$idx}
                } );
            }
            else {
                $self->error("EXT_T_2 $idx unknown");
            }
        }
        else {
            $self->error("EXT_T_2 unexpected");
        }
    }
    elsif ($tag == STR_T) {
        my $idx = $self->getmb32();
        my $string = $self->get_str_t($idx);
        return undef unless (defined $string);
        if (        defined $self->{App}
                and exists $self->{App}{variable_subs} ) {
            $string =~ s/\$/\$\$/g;
        }
        $self->SUPER::characters( {
                Data => $string
        } );
    }
    elsif ($tag == EXT_0) {
        $self->error("EXT_0 unexpected");
    }
    elsif ($tag == EXT_1) {
        $self->error("EXT_1 unexpected");
    }
    elsif ($tag == EXT_2) {
        $self->error("EXT_2 unexpected");
    }
    elsif ($tag == OPAQUE) {
        my $data = $self->get_opaque();
        return undef unless (defined $data);
        my $encoding = (defined $self->{App} and exists $self->{App}{TagEncoding}{$parent})
                     ? $self->{App}{TagEncoding}{$parent} : q{};
        if      ($encoding eq 'base64') {
            use MIME::Base64;
            my $encoded = encode_base64($data);
            $self->SUPER::characters( {
                    Data => $encoded
            } );
        }
        elsif ($encoding eq 'datetime') {
            my $len = length $data;
            my $value = q{};
            if ($len == 6) {
                my @byte  = unpack 'C*', $data;
                my $year  = ($byte[0] << 6) | ($byte[1] >> 2);
                my $month = (($byte[1] & 0x3) << 2) | ($byte[2] >> 6);
                my $day   = (($byte[2] >> 1) & 0x1F);
                my $hour  = (($byte[2] & 0x1) << 4) | ($byte[3] >> 4);
                my $min   = (($byte[3] & 0xF) << 2) | ($byte[4] >> 6);
                my $sec   = ($byte[4] & 0x3F);
                my $tz    = $byte[5];
                $value = sprintf('%04d%02d%02dT%02d%02d%02d%c',$year,$month,$day,$hour,$min,$sec,$tz);
            }
            else {
                $self->error("OPAQUE : invalid 'datetime'");
            }
            $self->SUPER::characters( {
                    Data => $value
            } );
        }
        elsif ($encoding eq 'integer') {
            my $len = length $data;
            my $value = 0;
            if      ($len == 1) {
                $value = unpack 'C', $data;
            }
            elsif ($len == 2) {
                $value = unpack 'n', $data;
            }
            elsif ($len == 4) {
                $value = unpack 'N', $data;
            }
            else {
                $self->error("OPAQUE : invalid 'integer'");
            }
            $self->SUPER::characters( {
                    Data => "$value"
            } );
        }
        else {
            $self->SUPER::characters( {
                    Data => $data
            } );
        }
    }
    else {
        my $rc = $self->element($tag);  # LITERAL and all TAG
        return undef unless (defined $rc);
    }
    return 1;
}

sub attribute {
    my $self = shift;
    my ($attr) = @_;

    return undef unless (defined $attr);
    if      ($attr == ENTITY) {     # ATTRV
        my $entcode = $self->getmb32();
        return undef unless (defined $entcode);
        $self->{attrv} .= chr $entcode;
    }
    elsif ($attr == STR_I) {        # ATTRV
        my $string = $self->get_str_i();
        return undef unless (defined $string);
        if (        exists $self->{ATTRSTART}{validate}
                and $self->{ATTRSTART}{validate} eq 'vdata' ) {
            $string =~ s/\$/\$\$/g;
        }
        $self->{attrv} .= $string;
    }
    elsif ($attr == LITERAL) {  # ATTRS
        my $idx = $self->getmb32();
        my $string = $self->get_str_t($idx);
        return undef unless (defined $string);
        $self->{attrs} = $string;
        $self->{attrv} = q{};
        $self->{ATTRSTART} = undef;
    }
    elsif ($attr == EXT_I_0) {  # ATTRV
        my $string = $self->get_str_i();
        return undef unless (defined $string);
        if (        defined $self->{ATTRSTART}
                and $self->{ATTRSTART}{validate} eq 'vdata' ) {
            $self->{attrv} .= "\$($string:escape)";
        }
        else {
            $self->error("EXT_I_0 unexpected");
        }
    }
    elsif ($attr == EXT_I_1) {  # ATTRV
        my $string = $self->get_str_i();
        return undef unless (defined $string);
        if (        defined $self->{ATTRSTART}
                and $self->{ATTRSTART}{validate} eq 'vdata' ) {
            $self->{attrv} .= "\$($string:unesc)";
        }
        else {
            $self->error("EXT_I_1 unexpected");
        }
    }
    elsif ($attr == EXT_I_2) {  # ATTRV
        my $string = $self->get_str_i();
        return undef unless (defined $string);
        if (        defined $self->{ATTRSTART}
                and $self->{ATTRSTART}{validate} eq 'vdata' ) {
            $self->{attrv} .= "\$($string)";
        }
        else {
            $self->error("EXT_I_2 unexpected");
        }
    }
    elsif ($attr == EXT_T_0) {  # ATTRV
        my $idx = $self->getmb32();
        if (        defined $self->{ATTRSTART}
                and $self->{ATTRSTART}{validate} eq 'vdata' ) {
            my $string = $self->get_str_t($idx);
            return undef unless (defined $string);
            $self->{attrv} .= "\$($string:escape)";
        }
        elsif (   defined $self->{App}
                and exists $self->{App}{EXT0VALUE}) {
            if (exists $self->{App}{EXT0VALUE}{$idx}) {
                $self->{attrv} .= $self->{App}{EXT0VALUE}{$idx}
            }
            else {
                $self->error("EXT_T_0 $idx unknown");
            }
        }
        else {
            $self->error("EXT_T_0 unexpected");
        }
    }
    elsif ($attr == EXT_T_1) {  # ATTRV
        my $idx = $self->getmb32();
        if (        defined $self->{ATTRSTART}
                and $self->{ATTRSTART}{validate} eq 'vdata' ) {
            my $string = $self->get_str_t($idx);
            return undef unless (defined $string);
            $self->{attrv} .= "\$($string:unesc)";
        }
        elsif (   defined $self->{App}
                and exists $self->{App}{EXT1VALUE}) {
            if (exists $self->{App}{EXT1VALUE}{$idx}) {
                $self->{attrv} .= $self->{App}{EXT1VALUE}{$idx}
            }
            else {
                $self->error("EXT_T_1 $idx unknown");
            }
        }
        else {
            $self->error("EXT_T_1 unexpected");
        }
    }
    elsif ($attr == EXT_T_2) {  # ATTRV
        my $idx = $self->getmb32();
        if (        defined $self->{ATTRSTART}
                and $self->{ATTRSTART}{validate} eq 'vdata' ) {
            my $string = $self->get_str_t($idx);
            return undef unless (defined $string);
            $self->{attrv} .= "\$($string)";
        }
        elsif (   defined $self->{App}
                and exists $self->{App}{EXT2VALUE}) {
            if (exists $self->{App}{EXT2VALUE}{$idx}) {
                $self->{attrv} .= $self->{App}{EXT2VALUE}{$idx}
            }
            else {
                $self->error("EXT_T_2 $idx unknown");
            }
        }
        else {
            $self->error("EXT_T_2 unexpected");
        }
    }
    elsif ($attr == STR_T) {        # ATTRV
        my $idx = $self->getmb32();
        my $string = $self->get_str_t($idx);
        return undef unless (defined $string);
        if (        exists $self->{ATTRSTART}{validate}
                and $self->{ATTRSTART}{validate} eq 'vdata' ) {
            $string =~ s/\$/\$\$/g;
        }
        $self->{attrv} .= $string;
    }
    elsif ($attr == EXT_0) {        # ATTRV
        $self->error("EXT_0 unexpected");
    }
    elsif ($attr == EXT_1) {        # ATTRV
        $self->error("EXT_1 unexpected");
    }
    elsif ($attr == EXT_2) {        # ATTRV
        $self->error("EXT_2 unexpected");
    }
    elsif ($attr == OPAQUE) {       # ATTRV
        my $data = $self->get_opaque();
        return undef unless (defined $data);
        if (        exists $self->{ATTRSTART}{encoding}
                and $self->{ATTRSTART}{encoding} eq 'iso-8601' ) {
            foreach (split //, $data) {
                $self->{attrv} .=  sprintf('%02X', ord $_);
            }
        }
        else {
            $self->error("OPAQUE unexpected");
        }
    }
    else {
        my $token = $attr; # & ATTR_MASK;
        $token += 256 * $self->{codepage_attr};
        if ($attr & 0x80) {
            if (        defined $self->{App}
                    and exists $self->{App}{ATTRVALUE}{$token}) {
                $self->{attrv} .= $self->{App}{ATTRVALUE}{$token};
            }
            else {
                $self->{attrv} .=  "ATTRV-$token";
                $self->warning("ATTRV-$token unreferenced");
            }
        }
        else {
            $self->{attrv} = q{};
            $self->{ATTRSTART} = undef;
            if (        defined $self->{App}
                    and exists $self->{App}{ATTRSTART}{$token} ) {
                $self->{ATTRSTART} = $self->{App}{ATTRSTART}{$token};
                $self->{attrs} = $self->{ATTRSTART}{name};
                $self->{attrv} = $self->{ATTRSTART}{value}
                        if (exists $self->{ATTRSTART}{value});
            }
            else {
                $self->{attrs} = "ATTRS-$token";
                $self->warning("ATTRS-$token unreferenced");
            }
        }
    }
    return 1;
}

sub get_tag {
    my $self = shift;
    my $ch = $self->{io_handle}->getc();
    return undef unless (defined $ch);
    my $tag = ord $ch;
    if ($tag == SWITCH_PAGE) {
        $ch = $self->{io_handle}->getc();
        return undef unless (defined $ch);
        $self->{codepage_tag} = ord $ch;
        $ch = $self->{io_handle}->getc();
        return undef unless (defined $ch);
        $tag = ord $ch;
    }
    return $tag;
}

sub get_attr {
    my $self = shift;
    my $ch = $self->{io_handle}->getc();
    return undef unless (defined $ch);
    my $attr = ord $ch;
    if ($attr == SWITCH_PAGE) {
        $ch = $self->{io_handle}->getc();
        return undef unless (defined $ch);
        $self->{codepage_attr} = ord $ch;
        $ch = $self->{io_handle}->getc();
        return undef unless (defined $ch);
        $attr = ord $ch;
    }
    return $attr;
}

sub get_str_i {
    my $self = shift;
    my $str = q{};
    my $ch = $self->{io_handle}->getc();
    return undef unless (defined $ch);
    while (ord $ch != 0) {
        $str .= $ch;
        $ch = $self->{io_handle}->getc();
        return undef unless (defined $ch);
    }
    return $str;
}

sub get_opaque {
    my $self = shift;
    my $data;
    my $len = $self->getmb32();
    return undef unless (defined $len);
    $self->{io_handle}->read($data,$len);
    return $data;
}

sub warning {
    my $self = shift;
    my ($msg) = @_;
    my $pos = $self->{io_handle}->tell();
    $self->{message_no_op} = __PACKAGE__ . ": Warning: $msg\n\tat position $pos\n";
    $self->SUPER::warning( {
            Message         => $msg,
            PublicId        => $self->{PublicId},
            ColumnNumber    => $pos,
            LineNumber      => 1,
            BytePosition    => $pos
    } );
}

sub error {
    my $self = shift;
    my ($msg) = @_;
    my $pos = $self->{io_handle}->tell();
    $self->{message_no_op} = __PACKAGE__ . ": Error: $msg\n\tat position $pos\n";
    $self->SUPER::error( {
            Message         => $msg,
            PublicId        => $self->{PublicId},
            ColumnNumber    => $pos,
            LineNumber      => 1,
            BytePosition    => $pos
    } );
}

sub no_op {
    my $self = shift;
    if (exists $self->{message_no_op}) {
        warn $self->{message_no_op};
        delete $self->{message_no_op};
    }
}

1;

__END__

=head1 NAME

WAP::SAXDriver::wbxml - SAX parser for WBXML file

=head1 SYNOPSIS

 use WAP::SAXDriver::wbxml;

 $parser = WAP::SAXDriver::wbxml->new( [OPTIONS] );
 $result = $parser->parse( [OPTIONS] );

=head1 DESCRIPTION

C<WAP::SAXDriver::wbxml> is a SAX2 driver, and it inherits of XML::SAX::Base.
This man page summarizes the specific options, handlers, and
properties supported by C<WAP::SAXDriver::wbxml>; please refer to the
SAX 2.0 standard for general usage information.

A WBXML file is the binarized form of XML file according the specification :

 WAP - Wireless Application Protocol /
 Binary XML Content Format Specification /
 Version 1.3 WBXML (15th May 2000 Approved)

This module could be parametrized by the file C<WAP::SAXDriver::wbrules.pl>
what contains all specific values used by WAP applications.

This module needs IO::File, IO::String and I18N::Charset modules.

=head1 METHODS

=over 4

=item new

Creates a new parser object.  Default options for parsing, described
below, are passed as key-value pairs or as a single hash.  Options may
be changed directly in the parser object unless stated otherwise.
Options passed to `C<parse()>' override the default options in the
parser object for the duration of the parse.

=item parse

Parses a document.  Options, described below, are passed as key-value
pairs or as a single hash.  Options passed to `C<parse()>' override
default options in the parser object.

=item parse_file, parse_uri, parse_string

These are all convenience variations on parse(), and in fact simply
set up the options before calling it.

=item location (SAX1)

Returns the location as a hash:

  BytePosition    The current byte position of the parse.
  ColumnNumber    The column number of the parse, equals to BytePosition.
  LineNumber      The line number of the parse, always equals to 1.
  PublicId        A string containing the public identifier, or undef
                  if none is available.

=back

=head1 OPTIONS

The following options are supported by C<WAP::SAXDriver::wbxml> :

 Handler              default handler to receive events
 DocumentHandler      handler to receive document events
 DTDHandler           handler to receive DTD events
 ErrorHandler         handler to receive error events
 Source               hash containing the input source for parsing
 UseOnlyDefaultRules  boolean, if true the file wap.wbrules2.pl is not loaded
 RulesPath            path of alternate rules (standard is WAP/SAXDriver/wap.wbrules2.pl)

If no handlers are provided then all events will be silently ignored,
except for `C<fatal_error()>' which will cause a `C<die()>' to be
called after calling `C<end_document()>'.

The `C<Source>' hash may contain the following parameters:

 ByteStream       The raw byte stream (file handle) containing the
                  document.
 String           A string containing the document.
 Encoding         A string describing the character encoding.

If more than one of `C<ByteStream>', or `C<String>',
then preference is given first to `C<ByteStream>', then `C<String>'.

=head1 HANDLERS

The following handlers and properties are supported by
C<WAP::SAXDriver::wbxml> :

=head2 Content Events

=over 4

=item start_document

Receive notification of the beginning of a document.

 Version          The XML version, always 1.0.
 Encoding         The encoding string, if any.
 Standalone       undefined.
 VersionWBXML     The version used for the binarization.

=item end_document

Receive notification of the end of a document.

No properties defined.

=item start_element

Receive notification of the beginning of an element.

 Name             The element type name.
 Attributes       A hash containing the attributes attached to the
                  element, if any.

The `C<Attributes>' hash contains only string values.

=item end_element

Receive notification of the end of an element.

 Name             The element type name.

=item characters

Receive notification of character data.

 Data             The characters from the XML document.

=item processing_instruction

Receive notification of a processing instruction.

 Target           The processing instruction target.
 Data             The processing instruction data, if any.

=back

=head2 Error Events

=over 4

=item warning

Receive notification of a warning event.

  Message         The detailed explanation.
  BytePosition    The current byte position of the parse.
  ColumnNumber    The column number of the parse, equals to BytePosition.
  LineNumber      The line number of the parse, always equals to 1.
  PublicId        A string containing the public identifier, or undef
                  if none is available.

=item error

Receive notification of an error event.

  Message         The detailed explanation.
  BytePosition    The current byte position of the parse.
  ColumnNumber    The column number of the parse, equals to BytePosition.
  LineNumber      The line number of the parse, always equals to 1.
  PublicId        A string containing the public identifier, or undef
                  if none is available.

=item fatal_error

Receive notification of a fatal error event.

  BytePosition    The current byte position of the parse.
  ColumnNumber    The column number of the parse, equals to BytePosition.
  LineNumber      The line number of the parse, always equals to 1.
  PublicId        A string containing the public identifier, or undef
                  if none is available.

=back

=head2 Lexical Events

=over 4

=item start_dtd

Receive notification of the beginning of a DTD

 Name             The document type name
 PublicId         The declared public identifier for the external DTD
 SystemId         The declared system identifier for the external DTD (may be wrong)

=item end_dtd

Receive notification of the end of a DTD.

No properties defined.

=back

=head2 SAX1 methods

=over 4

=item xml_decl

Deprecated in favour of start_document.

Receive notification of a XML declaration event.

 Version          The XML version, always 1.0.
 Encoding         The encoding string, if any.
 Standalone       undefined.
 VersionWBXML     The version used for the binarization.

=back

=head1 COPYRIGHT

(c) 2002-2007 Francois PERRAD, France.

This program is distributed under the terms of the Artistic Licence.

The WAP Specifications are copyrighted by the Wireless Application Protocol Forum Ltd.
See E<lt>http://www.wapforum.org/what/copyright.htmE<gt>.

=head1 AUTHOR

Francois PERRAD, francois.perrad@gadz.org

=head1 SEE ALSO

XML::SAX, XML::SAX::Base, WAP::wbxml

Extensible Markup Language (XML) http://www.w3c.org/XML/
Binary XML Content Format (WBXML) http://www.wapforum.org/
Simple API for XML (SAX) http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/perl-xml/libxml-perl/doc/sax-2.0.html?rev=HEAD&content-type=text/html

=cut