package PoserParser; use Carp; our $indent = 0; our $chanmode = 0; our $figureResFile;

sub new {
    my $class = shift;
    my $obj = {};
    bless $obj, ref $class || $class;
    return $obj;
}

sub read {
    my $obj = shift;
    my $filename = shift;
    local *PZ3;
    open PZ3, "<$filename"
       or carp "Can't read $filename: $!"
       and return undef;
    $obj->{_fh} = *PZ3{IO};
    my $fh = $obj->{_fh};
    $obj->readPZ3;
}


sub readPZ3 {
    $indent++;
    my $seq = 1;
    my $obj = shift;
    my $fh = $obj->{_fh};
    LINE: while (<$fh>) {
        chomp;
        s/^s+//g;
        s/s+$//g;
        next unless $_;
        if (/{/) {
            $chanmode++ if $chanmode;
#            warn " "x$indent, "Going to read subblock for $obj->{_lastkey}.n"
#                 if $obj->{_debug};
            my $subobj = {_debug => $obj->{_debug},
                          _fh => $obj->{_fh},
                          _seq => $seq};
            if ($chanmode >1 && $obj->{_lastkey} =~ /rotate([XYZ])/) {
                $obj->{_rotseq} .= lc $1;
            }
            $seq++;
            if (defined $obj->{_lastval}) {
                my $id;
                $subobj->{_id} = $obj->{_lastval};
#                warn " "x($indent+2), "(Block is $obj->{_lastkey}, ",
#                     "Subobject ID is $subobj->{_id})n", if $obj->{_debug};
            }
            bless $subobj, ref $obj;
            $subobj->readPZ3;
            if (defined $obj->{$obj->{_lastkey}}) {
                if (ref $obj->{$obj->{_lastkey}}) {
                    if (ref $obj->{$obj->{_lastkey}} eq 'ARRAY') {
                        if (my $idx = $obj->_hkin($obj->{$obj->{_lastkey}}, $obj->{_lastval})) {
                            ${$obj->{$obj->{_lastkey}}}[$idx-1] = {$obj->{_lastval} => {%{${$obj->{$obj->{_lastkey}}}[$idx-1]}, %{$subobj}}};
                            if (my $idx = $obj->_in($obj->{$obj->{_lastkey}}, $obj->{_lastval})) {
                                splice @{$obj->{$obj->{_lastkey}}}, $idx-1, 1;
#warn "I just removed index ",$idx-1," from $obj->{$obj->{_lastkey}}.nIt was $obj->{_lastval} as a scalar.n";
                            }
                        }
                        elsif (my $idx = $obj->_in($obj->{$obj->{_lastkey}}, $obj->{_lastval})) {
                            ${$obj->{$obj->{_lastkey}}}[$idx-1] = {$obj->{_lastval} => $subobj};
                        }
                        else {
                            push @{$obj->{$obj->{_lastkey}}}, $subobj;
                        }
                    }
                }
                else {
                    $obj->{$obj->{_lastkey}} = {$obj->{$obj->{_lastkey}} => $subobj};
                }
            }
            else {
                $obj->{$obj->{_lastkey}} = $subobj;
            }
        }
        elsif (/}/) {
            $chanmode-- if $chanmode;
            last LINE;
        }
        else {
            my ($key, $val);
            /^([a-zA-Z]+)(s+S.*)?$/;
            $key = $1;
            unless (defined $key) {
              warn "Undefined key! Line after $obj->{_lastkey}n";
            }
            if (defined $2) {
              $val = $2;
              $val =~ s/^s+//g;
            }
            if ($key eq 'sphereMatsRaw') {
                $val .= <$fh> for 1..9;
            }
            if ($key eq 'valueOpDeltaAdd') {
                $val .= <$fh> for 1..3;
            }
            if ($key eq 'addChild' or $key eq 'weld') {
                $val .= <$fh>;
            }
            if ((   $key eq 'textureMap'
                 or $key eq 'reflectionMap'
                 or $key eq 'transparencyMap'
                 or $key eq 'bumpMap')
                and $val ne 'NO_MAP') {
                $val .= <$fh>;
            }
            if ($key eq 'channels') {
                $chanmode = 1;
            }
            if ($key eq 'figureResFile') {
                $figureResFile = $val;
            }
            if ($key eq 'geomHandlerGeom') {
                $val = { objFile => $figureResFile,
                         group => $val };
            }
            if (defined $obj->{$key}) {
                if (ref $obj->{$key} eq 'ARRAY') {
                    push @{$obj->{$key}}, $val;
                }
                else {
                    $obj->{$key} = [$obj->{$key}, $val];
                }
            }
            else {
                $obj->{$key} = $val;
            }
            $obj->{_lastkey} = $key;
            $obj->{_lastval} = defined $val?$val:undef;
        }
    }
    $indent--;
}

sub _in {
    my $obj = shift;
    my $ary = shift;
    my $term = shift;
    return undef unless $ary && $term && ref $ary eq 'ARRAY';
    my $count = 0;
    for my $item (@{$ary}) {
        $count++;
        return $count if $item eq $term;
    }
    return undef;
}

sub _hkin {
    my $obj = shift;
    my $ary = shift;
    my $term = shift;
    return undef unless $ary && $term && ref $ary eq 'ARRAY';
    my $count = 0;
    for my $item (@{$ary}) {
        $count++;
        if (ref $item eq 'HASH') {
            return $count if $obj->_in([keys %{$item}], $term);
        }
    }
    return undef;
}

1;

I'm sure there are some weirdnesses in this but it's working finally. B^) Next step is to make it actually PARSE now that I can get the data structure read.