chkjson.pl to HTML.

index -|- end

Generated: Sun Mar 2 17:19:37 2014 from chkjson.pl 2014/03/01 35.5 KB. text copy

#!/usr/bin/perl -w
# NAME: chkjson.pl
# AIM: Read a JSON file, and re-line it and output
# 01/03/2014 - Do NOT add space when joining lines
# 13/02/2014 - Reduce moise if NOT Three.js
# 21/06/2013 - More checks IFF it is a Three.js JSON file
# 06/03/2013 - Added batch file to run it
# 26/12/2012 - Add some default test code
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use File::Spec; # File::Spec->rel2abs($rel); # get ABSOLUTE form
use Cwd;
use JSON;
use Data::Dumper;
use Time::gmtime;
my $os = $^O;
my $perl_dir = '/home/geoff/bin';
my $PATH_SEP = '/';
my $temp_dir = '/tmp';
if ($os =~ /win/i) {
    $perl_dir = 'C:\GTools\perl';
    $temp_dir = $perl_dir;
    $PATH_SEP = "\\";
}
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
# log file stuff
our ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt";
open_log($outfile);

# user variables
my $VERS = "0.0.4 2014-02-13";
#my $VERS = "0.0.3 2013-06-21";
#my $VERS = "0.0.2 2013-03-06";
#my $VERS = "0.0.1 2012-07-18";
my $load_log = 0;
my $in_file = '';
my $verbosity = 0;
my $out_file = '';
my $use_json_module = 1;
my $test_3j = 0;

# ### DEBUG ###
my $debug_on = 0;
#my $def_file = 'C:\FG\18\blendac3d\cube2.js';
my $def_file = 'C:\FG\18\blendac3d\cube.js';
#my $def_file = 'C:\FG\17\fgx-globe\fgx-planes\f16\f16.js';
#my $def_file = 'C:\GTools\perl\temp-apts\PHLI.json';
#my $def_file = 'C:\FG\17\build-cf\expired.json';
my $tmp_json = $perl_dir.'\temptest.json';
# my $tmp_json = $def_file;

### program variables
my @warnings = ();
my $cwd = cwd();

sub VERB1() { return $verbosity >= 1; }
sub VERB2() { return $verbosity >= 2; }
sub VERB5() { return $verbosity >= 5; }
sub VERB9() { return $verbosity >= 9; }

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        prt( "\nNo warnings issued.\n\n" ) if (VERB9());
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

sub get_test_json() {
    my $json = <<EOF;
{"success":true,
"source":"test_http.cxx",
"started":"2012-12-25 19:05:06",
"info":[{
   "TTL_secs":"10",
   "min_dist_m":"2000",
   "min_speed_kt":"20",
   "min_hdg_chg_deg":"1",
   "min_alt_chg_ft":"100",
   "tracker_log":"none",
   "tracker_db":"fgxtracker" ,
   "current_time":"2012-12-25 19:08:18 UTC",
   "secs_in_http":"0.2",
   "secs_running":"192.1"}]
,"ips":[
   {"ip":"127.0.0.1","cnt":"2","br":["MSIE"]},
   {"ip":"192.168.1.105","cnt":"7","br":["Opera","Lynx"]},
   {"ip":"192.168.1.174","cnt":"7","br":["MSIE","Safari"]}]
,"ip_stats":[{
   "rq":"16",
   "rcv":"12",
   "wb":"4",
   "err":"0",
   "rb":"3999",
   "se":"0",
   "sb":"52207",
   "av":"0.011 secs"}]
}
EOF
    return $json;
}

sub reline_json($) {
    my $ra = shift; # \@lines);
    my $line = join("\n",@{$ra});
    my $len = length($line);
    my @braces = ();
    my ($i,$ch,$brcnt,$ind,$indent,$inquot,$tag,$ch2,$i2);
    my ($pc,$lnn,$warns,$lc,$ri,$name,$it,$stag);
    $indent = '    ';
    $inquot = 0;
    $tag = '';
    $lnn = 1;
    $warns = 0;
    my @actitem = ();
    $lc = '';
    $name = '';
    my @itemtyp = ();
    my @master = ();
    for ($i = 0; $i < $len; $i++) {
        $ch = substr($line,$i,1);
        if ($inquot) {
            $inquot = 0 if ($ch eq '"');
        } else {
            if ($ch =~ /\s/) {
                if ($ch eq "\n") {
                    $lnn++;
                }
                next;
            }
            if ($ch eq '"') {
                $inquot = 1;
            } elsif ($ch eq '{') {
                $lc = $ch;
                if (length($tag)) {
                    if (@actitem) {
                        $ri = $actitem[-1];
                        $it = $itemtyp[-1];
                        #$stag = strip_quotes($tag);
                        #if ($it eq '{') {
                        #    ${$ri}{$name} = $stag;
                        #} elsif ($it eq '[') {
                        #    push(@{$ri},[$name,$stag]);
                        #} else {
                        #    prt("WARNING: $lnn: Got $ch with $it, NO last character\n");
                        #    $warns++;
                        #}
                    } else {
                        prtw("WARNING: $lnn: Got $ch with NO items on stack!\n");
                        $warns++;
                    }
                }
                my %h = ();
                push(@actitem,\%h); # start hash
                push(@itemtyp,$lc); # and keep type
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                if (length($tag)) {
                    prt($ind.$name.':'.$tag." $ch\n");
                } else {
                    prt($ind."$ch\n");
                }
                push(@braces,$ch);
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                $ch = '';
                $tag = ''
            } elsif ($ch eq '}') {
                if (length($tag)) {
                    $stag = strip_quotes($tag);
                    prt($ind.$name.':'."$stag\n");
                }
                if (@braces) {
                    $pc = pop @braces;
                    $ri = pop @actitem;
                    $it = pop @itemtyp;
                    if ($pc ne '{') {
                        prtw("WARNING: $lnn: popped '$pc' NOT '{'!\n");
                        $warns++;
                    } else {
                        $stag = strip_quotes($tag);
                        if ($it eq '{') {
                            ${$ri}{$name} = $stag;
                        } elsif ($it eq '[') {
                            push(@{$ri},[$name,$stag]);
                        } else {
                            prt("WARNING: $lnn: Got $ch with $it, NO last character\n");
                            $warns++;
                        }
                        push(@master,$ri);
                    }
                } else {
                    prtw("WARNING: $lnn: Got $ch with none on stack!\n");
                    $warns++;
                }
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                $i2 = $i + 1;
                for (; $i2 < $len; $i2++) {
                    $ch2 = substr($line,$i2,1);
                    next if ($ch2 =~ /\s/);
                    if ($ch2 eq ',') {
                        $ch .= $ch2;
                        $i = $i2;
                        last;
                    } else {
                        last;
                    }
                }
                prt($ind."$ch\n");
                $ch = '';
                $tag = '';
            } elsif ($ch eq '[') {
                $lc = $ch;
                my @a = ();
                push(@actitem,\@a); # start array
                push(@itemtyp,$lc); # and type
                prt($ind.$name.':'.$tag." $ch\n");
                # $ind .= $indent;
                push(@braces,$ch);
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                $tag = '';
                $ch = '';
            } elsif ($ch eq ']') {
                if (length($tag)) {
                    $stag = strip_quotes($tag);
                    prt($ind.$name.':'."$stag\n");
                }
                if (@braces) {
                    $pc = pop @braces;
                    $ri = pop @actitem;
                    $it = pop @itemtyp;
                    if ($pc ne '[') {
                        prtw("WARNING: $lnn: popped '$pc' NOT '['!\n");
                        $warns++;
                    } else {
                        $stag = strip_quotes($tag);
                        if ($it eq '{') {
                            ${$ri}{$name} = $stag;
                        } elsif ($it eq '[') {
                            push(@{$ri},[$name,$stag]);
                        } else {
                            prt("WARNING: $lnn: Got $ch with $it, NO last character\n");
                            $warns++;
                        }
                        push(@master,$ri);
                    }
                } else {
                    prt("WARNING: $lnn: Got $ch with none on stack\n");
                    $warns++;
                }
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                $i2 = $i + 1;
                for (; $i2 < $len; $i2++) {
                    $ch2 = substr($line,$i2,1);
                    next if ($ch2 =~ /\s/);
                    if ($ch2 eq ',') {
                        $ch .= $ch2;
                        $i = $i2;
                        last;
                    } else {
                        last;
                    }
                }
                prt($ind." $ch\n");
                $ch = '';
                $tag = '';
            } elsif ($ch eq ',') {
                if (length($tag)) {
                    $stag = strip_quotes($tag);
                    prt($ind.$name.':'.$stag."$ch\n");
                    if (@actitem) {
                        $ri = $actitem[-1];
                        $lc = $itemtyp[-1];
                        if ($lc eq '{') {
                            ${$ri}{$name} = $stag;
                        } elsif ($lc eq '[') {
                            push(@{$ri},[$name,$stag]);
                        } else {
                            prt("WARNING: $lnn: Got $ch with NO last character\n");
                            $warns++;
                        }
                    } else {
                        prt("WARNING: $lnn: Got $ch with none on stack\n");
                        $warns++;
                    }
                } else {
                    prt($ind."$ch\n");
                }
                $ch = '';
                $tag = '';
            } elsif ($ch eq ':') {
                if (length($tag)) {
                    $name = strip_quotes($tag);
                } else {
                    prt("WARNING: $lnn: Got $ch with NO object name!\n");
                    $warns++;
                }
                $ch = '';
                $tag = '';
            } 
        }
        $tag .= $ch;
    }
    if ($warns) {
        prt("Got $warns warnings!\n");
    } else {
        prt("\nDump of master array...\n");
        $lnn = Dumper(@master);
        prt("$lnn\n");
        prt("End of DUMP\n");
    }
}

sub reline_json_OK($) {
    my $ra = shift; # \@lines);
    my $line = join("\n",@{$ra});
    my $len = length($line);
    my @braces = ();
    my ($i,$ch,$brcnt,$ind,$indent,$inquot,$tag,$ch2,$i2);
    $indent = '    ';
    $inquot = 0;
    $tag = '';
    for ($i = 0; $i < $len; $i++) {
        $ch = substr($line,$i,1);
        if ($inquot) {
            $inquot = 0 if ($ch eq '"');
        } else {
            next if ($ch =~ /\s/);
            if ($ch eq '"') {
                $inquot = 1;
            } elsif ($ch eq '{') {
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                prt($ind.$tag." $ch\n");
                push(@braces,$ch);
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                $ch = '';
                $tag = ''
            } elsif ($ch eq '}') {
                prt($ind."$tag\n") if (length($tag));
                $tag = '';
                if (@braces) {
                    pop @braces;
                } else {
                    prt("WARNING: Got $ch with none on stack\n");
                }
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                $i2 = $i + 1;
                for (; $i2 < $len; $i2++) {
                    $ch2 = substr($line,$i2,1);
                    next if ($ch2 =~ /\s/);
                    if ($ch2 eq ',') {
                        $ch .= $ch2;
                        $i = $i2;
                        last;
                    } else {
                        last;
                    }
                }
                prt($ind."$ch\n");
                $ch = '';
            } elsif ($ch eq '[') {
                prt($ind.$tag." $ch\n");
                $tag = '';
                $ch = '';
                $ind .= $indent;
            } elsif ($ch eq ']') {
                $i2 = $i + 1;
                $brcnt = scalar @braces;
                $ind = $indent x $brcnt;
                for (; $i2 < $len; $i2++) {
                    $ch2 = substr($line,$i2,1);
                    next if ($ch2 =~ /\s/);
                    if ($ch2 eq ',') {
                        $ch .= $ch2;
                        $i = $i2;
                        last;
                    } else {
                        last;
                    }
                }
                prt($ind."$tag\n") if (length($tag));
                $tag = '';
                prt($ind." $ch\n");
                $ch = '';
            } elsif ($ch eq ',') {
                prt($ind.$tag."$ch\n");
                $ch = '';
                $tag = '';
            } 
        }
        $tag .= $ch;
    }
}

my %threejs_meta = (
    'morphTargets' => 'TEXT',
    'faces' => 'TEXT',
    'bones' => 'TEXT',
    'colors' => 'TEXT',
    'formatVersion' => 'TEXT',
    'vertices' => 'TEXT',
    'normals' => 'TEXT',
    'uvs' => 'ARRAY',
    'materials' => 'TEXT',
    'generatedBy' => 'TEXT'
    );

my $nmFaces = -1;
my $nmNorms = -1;
my $nmVerts = -1;

sub show_metadata($) {
    my $val = shift;
    my $rtj = \%threejs_meta;
    my ($key,$typ,$v2,$msg);
    $msg = "metadata: ";
    foreach $key (keys %{$rtj}) {
        $typ = ${$rtj}{$key};
        if (defined ${$val}{$key}) {
            $v2 = ${$val}{$key};
            if ($typ eq 'TEXT') {
                $msg .= "$key=$v2 ";
                if ($key eq 'faces') {
                    $nmFaces = $v2;
                } elsif ($key eq 'normals') {
                    $nmNorms = $v2;
                } elsif ($key eq 'vertices') {
                    $nmVerts = $v2;
                }
            }
        } else {
            prt("$key: not in 'metadata'!\n");
        }
    }
    prt("$msg\n") if (VERB2());
    prt("meta summary: vertices=$nmVerts, normals=$nmNorms, faces=$nmFaces\n"); 
}

sub isBitSet($$) {
    my ($val, $pos) = @_;
   return ($val & ( 1 << $pos )) ? 1 : 0;
}

sub show_type_flag($) {
    my $type = shift;
   my $isQuad              = isBitSet( $type, 0 );
   my $hasMaterial         = isBitSet( $type, 1 );
   my $hasFaceUv           = isBitSet( $type, 2 );
   my $hasFaceVertexUv     = isBitSet( $type, 3 );
   my $hasFaceNormal       = isBitSet( $type, 4 );
   my $hasFaceVertexNormal = isBitSet( $type, 5 );
   my $hasFaceColor       = isBitSet( $type, 6 );
   my $hasFaceVertexColor  = isBitSet( $type, 7 );
    ###prt("Type $type bits ".$isQuad.$hasMaterial.$hasFaceUv.$hasFaceVertexUv.$hasFaceNormal.$hasFaceVertexNormal.$hasFaceColor.$hasFaceVertexColor." ");
    prt("Type $type bits ".$hasMaterial.$hasFaceUv.$hasFaceVertexUv.$hasFaceNormal.$hasFaceVertexNormal.$hasFaceColor.$hasFaceVertexColor.$isQuad." ");
    prt(sprintf("hasMat=%s ", ($hasMaterial ? "On" : "Off")));              # 7
    prt(sprintf("hasFUv=%s ", ($hasFaceUv ? "On" : "Off")));                # 6
    prt(sprintf("hasVUv=%s ", ($hasFaceVertexUv ? "On" : "Off")));          # 5
    prt(sprintf("hasFNorm=%s ", ($hasFaceNormal ? "On" : "Off")));          # 4
    prt(sprintf("hasVNorm=%s ", ($hasFaceVertexNormal ? "On" : "Off")));    # 3
    prt(sprintf("hasFC=%s ", ($hasFaceColor ? "On" : "Off")));              # 2
    prt(sprintf("hasVC=%s ", ($hasFaceVertexColor ? "On" : "Off")));        # 1
    prt(sprintf("isQad=%s ", ($isQuad ? "On" : "Off")));                    # 0
    prt("\n");
}

sub scan_face_array($$) {
    my ($ra,$rva) = @_;
    my $cnt = scalar @{$ra};
    my $veccnt = scalar @{$rva};
    my $off = 0;
    my ($type,$vcnt,$i,$vi,$j,$vec);
    my @vind = ();
    my @nind = ();
    my @vecvals = ();
    my $fcnt = 0;
    while ($off < $cnt) {
        $fcnt++;    # count another FACE
        $type = ${$ra}[$off++];
        my $isQuad              = isBitSet( $type, 0 );
        my $hasMaterial         = isBitSet( $type, 1 );
        my $hasFaceUv           = isBitSet( $type, 2 );
        my $hasFaceVertexUv     = isBitSet( $type, 3 );
        my $hasFaceNormal       = isBitSet( $type, 4 );
        my $hasFaceVertexNormal = isBitSet( $type, 5 );
        my $hasFaceColor       = isBitSet( $type, 6 );
        my $hasFaceVertexColor  = isBitSet( $type, 7 );
        $vcnt = 3;
        if ($isQuad) {
            $vcnt = 4;
        }
        @vind = ();
        @vecvals = ();
        for ($i = 0; $i < $vcnt; $i++) {
            if ($off >= $cnt) {
                prtw("WARNING: face array expired in getting vertices\n");
                return 0;
            }
            $vi = ${$ra}[$off++];
            $vind[$i] = $vi# get the vertices indexes
            $vi *= 3;   # get index into vertices array
            if (($vi + 2) >= $veccnt) {
                prtw("WARNING: vector index $vi GTT|EQU count $veccnt!\n");
                return 0;
            }
            for ($j = 0; $j < 3; $j++) {
                $vec = ${$rva}[$vi + $j];
            }
        }
        if ($hasMaterial) {
            if ($off >= $cnt) {
                prtw("WARNING: face array expired in getting material\n");
                return 0;
            }
            my $mind = ${$ra}[$off++];
        }
        # other NOT found
        if ($hasFaceUv) {
            prtw("WARNING: Has unhandled FaceUv values\n");
            return 0;
        }
        if ($hasFaceVertexUv) {
            prtw("WARNING: Has unhandled FaceVertexUv values\n");
            return 0;
        }
        if ($hasFaceNormal) {
            prtw("WARNING: Has unhandled FaceNormal values\n");
            return 0;
        }
        @nind = ();
        if ($hasFaceVertexNormal) {
            # assume SAME count as vertices
            for ($i = 0; $i < $vcnt; $i++) {
                if ($off >= $cnt) {
                    prtw("WARNING: face array expired in getting FaceVertexNormal\n");
                    return 0;
                }
                $nind[$i] = ${$ra}[$off++];  # get the vertices indexes
            }
        }
        if ($hasFaceColor) {
            prtw("WARNING: Has unhandled FaceColor values\n");
            return 0;
        }
        if ($hasFaceVertexColor) {
            prtw("WARNING: Has unhandled FaceColor values\n");
            return 0;
        }
    }
    return $fcnt;
}


# ==========================================================================
# IFF it IS a Three.js JSON file, then do MORE checks
# Criteria - if it is a Three.js json then will be a HASH
# with defines for 'metadata', 'uvs', 'vertices', 'normals' and 'faces'
# return > 0 if a critical three.js error
# ==========================================================================
sub show_json_threejs($) {
    my $rh = shift;     # ($perl_scalar);
    my $bad = 0;
    my ($rt,$ra,$cnt,$verts,$item,$norms,$uvs,$faces);
    my $offset = 0;
    my ($type,$isQuad,$hasMaterial,$hasFaceUv,$hasFaceVertexUv);
   my ($hasFaceNormal,$hasFaceVertexNormal,$hasFaceColor,$hasFaceVertexColor);
    my (@face,$i,$meta,$cnt3,$msg);
    my $nUvLayers = 0;
    my $nVertices = 0;
    my $nNormals = 0;
    my $nFaces = 0;
    $rt = ref($rh);
    $msg = '';
    if ($rt eq 'HASH') {
        $item = 'metadata';
        if (defined ${$rh}{$item}) {
            $meta = ${$rh}{$item};
            $rt = ref($meta);
            if ($rt eq 'HASH') {
                show_metadata($meta);
            } else {
                prt("ERROR: $item: NOT a HASH! got [$rt]\n");
                $bad++;
            }
        } else {
            $bad++;
            prt("ERROR: $item NOT defined!\n") if (VERB5());
        }

        $item = 'uvs';
        if (defined ${$rh}{$item}) {
            $uvs = ${$rh}{$item};
            $rt = ref($uvs);
            if ($rt eq 'ARRAY') {
                $nUvLayers = scalar @{$uvs};
                prt("$item: Got array of $nUvLayers items...\n");
            } else {
                prt("ERROR: $item: NOT an ARRAY! got $rt\n");
                $bad++;
            }
        } else {
            prt("$item: NOT defined!, but is not critical\n") if (VERB5());
        }

        $item = 'vertices';
        if (defined ${$rh}{$item}) {
            $verts = ${$rh}{$item};
            $rt = ref($verts);
            if ($rt eq 'ARRAY') {
                $cnt = scalar @{$verts};
                $cnt3 = $cnt / 3;
                prt("$item: Got array of $cnt3 verts, $cnt items...\n");
                $nVertices = $cnt;
            } else {
                prt("ERROR: $item: NOT an ARRAY! got $rt\n");
                $bad++;
            }
        } else {
            prt("ERROR: $item: NOT defined! MUST have vertices!\n") if (VERB5());
            $bad++;
        }
        $item = 'normals';
        if (defined ${$rh}{$item}) {
            $norms = ${$rh}{$item};
            $rt = ref($norms);
            if ($rt eq 'ARRAY') {
                $cnt = scalar @{$norms};
                $cnt3 = $cnt / 3;
                prt("$item: Got array of $cnt3 norms, $cnt items...\n");
                $nNormals = $cnt;
            } else {
                prt("ERROR: $item: NOT an ARRAY! got $rt\n");
                $bad++;
            }
        } else {
            prt("$item: NOT defined! But not essential\n") if (VERB5());
        }
        $item = 'faces';
        if (defined ${$rh}{$item}) {
            $ra = ${$rh}{$item};
            $rt = ref($ra);
            if ($rt eq 'ARRAY') {
                $cnt = scalar @{$ra};
                prt("$item: Got array of $cnt items...\n");
                $nFaces = $cnt;
                $faces = $ra;
            } else {
                prt("ERROR: $item: NOT an ARRAY! got $rt\n");
                $bad++;
            }
        } else {
            prt("ERROR: $item: NOT defined! MUST have faces!\n") if (VERB5());
            $bad++;
        }
    } else {
        prt("ERROR: NOT a HASH! got $rt\n");
        $bad++;
    }
    $offset = 0;
    if (!$bad) {
        $ra = $faces;
        $cnt3 = scan_face_array($ra,$verts);    # a pre-scan of indexes in faces
        $msg = "Summary: Faces: $cnt3 ($nFaces), ";
        $cnt3 = $nVertices / 3; 
        $msg .= "Verts: $cnt3 ($nVertices), ";
        $cnt3 = $nNormals / 3;
        $msg .= "norms $cnt3 ($nNormals)";
        prt("$msg\n");
        $cnt = scalar @{$ra};
    }
    
    if (!$bad && $nFaces && $nVertices && ($offset < $cnt)) {
        prt("parse this STRANGE faces array...\n") if (VERB1());
    } else {
        prt("No parse of the STRANGE faces array...\n") if (VERB1());
    }
    ###while (!$iret && $nFaces && $nVertices && $nNormals && ($offset < $cnt)) {
    my ($vind);
    my @vertindexs = ();
    my @normindexs = ();
    my @matindexs = ();
    while (!$bad && $nFaces && $nVertices && ($offset < $cnt)) {
        # get FLAG bits
        $type = ${$ra}[$offset++];
        $msg = "Type $type ";
        show_type_flag($type) if (VERB5());
        $isQuad              = isBitSet( $type, 0 );
        $hasMaterial         = isBitSet( $type, 1 );
        $hasFaceUv           = isBitSet( $type, 2 );
        $hasFaceVertexUv     = isBitSet( $type, 3 );
        $hasFaceNormal       = isBitSet( $type, 4 );
        $hasFaceVertexNormal = isBitSet( $type, 5 );
        $hasFaceColor        = isBitSet( $type, 6 );
        $hasFaceVertexColor  = isBitSet( $type, 7 );
        #//console.log("type", type, "bits", isQuad, hasMaterial, hasFaceUv, hasFaceVertexUv, hasFaceNormal, hasFaceVertexNormal, hasFaceColor, hasFaceVertexColor);
        ###prt("Type $type bits ".$isQuad.$hasMaterial.$hasFaceUv.$hasFaceVertexUv.$hasFaceNormal.$hasFaceVertexNormal.$hasFaceColor.$hasFaceVertexColor." ");
        ###$msg .= "bits ".$hasMaterial.$hasFaceUv.$hasFaceVertexUv.$hasFaceNormal.$hasFaceVertexNormal.$hasFaceColor.$hasFaceVertexColor.$isQuad." ";
        $msg .= "bits ".$hasFaceVertexColor.$hasFaceColor.$hasFaceVertexNormal.$hasFaceNormal.$hasFaceVertexUv.$hasFaceUv.$hasMaterial.$isQuad." ";
        @face = ();
        # get vertices indexes - 4 or 3 only
        if ( $isQuad ) {
            #face = new THREE.Face4();
            $nVertices = 4;
        } else {
            #face = new THREE.Face3();
            $nVertices = 3;
        }
        for ( $i = 0; $i < $nVertices; $i++ ) {
            $vind = ${$ra}[ $offset++ ];
            $face[$i] = $vind;
            $vertindexs[$vind] = 1;
        }

        $msg .= join(",",@face)." ";
        if ($offset > $cnt) {
            prt("ERROR: Offset $offset GTT count $cnt\n");
            $bad++;
            last;
        }
        # if a 'material' flag
        if ( $hasMaterial ) {
            my $materialIndex = ${$ra}[ $offset ++ ];
            #   face.materialIndex = materialIndex;
            #$msg .= 'hasMaterial ';
            $msg .= "M=$materialIndex ";
            $matindexs[$materialIndex] = 1;
        }
        if ($offset > $cnt) {
            prt("ERROR: Offset $offset GTT count $cnt\n");
            $bad++;
            last;
        }
        # if has 'uvs' indexes
        #   // to get face <=> uv index correspondence
        #   fi = geometry.faces.length;
        if ( $hasFaceUv ) {
            if ($nUvLayers) {
                for ( $i = 0; $i < $nUvLayers; $i++ ) {
                    #uvLayer = json.uvs[ i ];
                    my $uvIndex = ${$ra}[ $offset ++ ];
                    #u = uvLayer[ uvIndex * 2 ];
                    #v = uvLayer[ uvIndex * 2 + 1 ];
                    #geometry.faceUvs[ i ][ fi ] = new THREE.Vector2( u, v );
                }
            } else {
                prt("ERROR: FACES failed - has FaceUv flag, but NO uvLayers!\n");
                $bad++;
                last;
            }
        }
        if ($offset > $cnt) {
            prt("ERROR: Offset $offset GTT count $cnt\n");
            $bad++;
            last;
        }
        if ( $hasFaceVertexUv ) {
            if ($nUvLayers) {
                for ( $i = 0; $i < $nUvLayers; $i++ ) {
                    #uvLayer = json.uvs[ i ];
                    #uvs = [];
                    #for ( j = 0; j < nVertices; j ++ ) {
                    my $uvIndex = ${$ra}[ $offset ++ ];
                    #    u = uvLayer[ uvIndex * 2 ];
                    #    v = uvLayer[ uvIndex * 2 + 1 ];
                    #    uvs[ j ] = new THREE.Vector2( u, v );
                    #}
                    #geometry.faceVertexUvs[ i ][ fi ] = uvs;
                }
            } else {
                prt("ERROR: FACES failed - has FaceVertexUv flag, but NO uvLayers!\n");
                $bad++;
                last;
            }
        }
        if ( $hasFaceNormal ) {
            my $normalIndex = ${$ra}[ $offset ++ ] * 3;
            #normal = new THREE.Vector3();
            #normal.x = normals[ normalIndex ++ ];
            #normal.y = normals[ normalIndex ++ ];
            #normal.z = normals[ normalIndex ];
            #face.normal = normal;
            $msg .= "FaceNorm index $normalIndex ";
        }
        if ( $hasFaceVertexNormal ) {
            $msg .= "FaceVertNorm ";
            if ($nNormals) {
                for ( $i = 0; $i < $nVertices; $i++ ) {
                    my $normalIndex = ${$ra}[ $offset ++ ];
                    $normindexs[$normalIndex] = 1;
                    $normalIndex *= 3;
                    #normal = new THREE.Vector3();
                    #normal.x = normals[ normalIndex ++ ];
                    #normal.y = normals[ normalIndex ++ ];
                    #normal.z = normals[ normalIndex ];
                    #face.vertexNormals.push( normal );
                    if ($normalIndex < $nNormals) {
                        if (VERB9()) {
                            # show normals
                            $msg .= ${$norms}[ $normalIndex++ ]." ";
                            $msg .= ${$norms}[ $normalIndex++ ]." ";
                            $msg .= ${$norms}[ $normalIndex++ ]." ";
                        } else {
                            # just show the INDEXES
                            $msg .= "$normalIndex ";
                        }
                    } else {
                        prt("Index $normalIndex out of $nNormals range!\n");
                    }
                    if ($offset > $cnt) {
                        prt("ERROR: Offset $offset GTT count $cnt\n");
                        $bad++;
                        last;
                    }
                }
            } else {
                prt("ERROR: FACES failed - has FaceVertexNorm flag, but NO nNorms!\n");
                $bad++;
                last;
            }
        }
        if ( $hasFaceColor ) {
            $msg .= "hasFaceColor ";
            my $colorIndex = ${$ra}[ $offset ++ ];
            ###color = new THREE.Color( colors[ colorIndex ] );
            ###face.color = color;
        }
        if ( $hasFaceVertexColor ) {
            $msg .= "hasFaceVertColor ";
            for ( $i = 0; $i < $nVertices; $i++ ) {
                my $colorIndex = ${$ra}[ $offset ++ ];
                #color = new THREE.Color( colors[ colorIndex ] );
                #face.vertexColors.push( color );
            }
        }
        prt("$msg\n") if (VERB1());
        ##$msg .= "\n";
        ###last;
    }
    if (!$bad) {
        $cnt = scalar @vertindexs;
        if ($cnt) {
            $cnt3 = 0;
            $msg = '';
            for ($i = 0; $i < $cnt; $i++) {
                if ( ! defined $vertindexs[$i] ) {
                    $msg .= "$i ";
                    $cnt3++;
                }
            }
            prt("Vert indexs: $cnt: $cnt3 NOT USED $msg\n");
        }
        $cnt = scalar @normindexs;
        if ($cnt) {
            $cnt3 = 0;
            $msg = '';
            for ($i = 0; $i < $cnt; $i++) {
                if ( ! defined $normindexs[$i] ) {
                    $msg .= "$i ";
                    $cnt3++;
                }
            }
            prt("Norm indexs: $cnt: $cnt3 NOT USED $msg\n");
        }
        $cnt = scalar @matindexs;
        if ($cnt) {
            $cnt3 = 0;
            $msg = '';
            for ($i = 0; $i < $cnt; $i++) {
                if ( ! defined $matindexs[$i] ) {
                    $msg .= "$i ";
                    $cnt3++;
                }
            }
            prt("Mat indexs: $cnt: $cnt3 NOT USED $msg\n");
        }
    }
    ###prt("$msg\n") if (VERB5());
    ###exit(1);
    return $bad;
}

sub process_in_file($) {
    my ($inf) = @_;
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    my ($line,$cnt,$lnn,$i,$fid,$secs,$ctr,$tm,$ccnt);
    $cnt = sprintf("%3d",$lncnt);
    $line = join("",@lines);
    $lnn = length($line);
    prt("Processing $cnt lines, $lnn chars, from [$inf]...\n");
    $lnn = 0;
    if ($use_json_module) {
        my $json = JSON->new->allow_nonref;
        my $perl_scalar = $json->decode( $line );
        if ($test_3j) {
            my $res = show_json_threejs($perl_scalar);
            if ($res) {
                prt("Does not appear to be a three.js file, or has errors\n");
            } else {
                prt("Appears a well formed three.js file.\n");
            }
        }
        $lnn = Dumper($perl_scalar);
        if (VERB9()) {
            prt("Dump of perl scalar...\n");
            prt("$lnn\n");
            prt("End DUMP\n");
        } else {
            prt("Done json->decode(json), and appears successful.\n");
        }
    } else {
        reline_json(\@lines);
    }
}

#########################################
### MAIN ###
parse_args(@ARGV);
process_in_file($in_file);
pgm_exit(0,"");
########################################

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av);
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^v/) {
                if ($sarg =~ /^v.*(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Verbosity = $verbosity\n") if (VERB1());
            } elsif ($sarg =~ /^l/) {
                if ($sarg =~ /^ll/) {
                    $load_log = 2;
                } else {
                    $load_log = 1;
                }
                prt("Set to load log at end. ($load_log)\n") if (VERB1());
            } elsif ($sarg =~ /^o/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_file = $sarg;
                prt("Set out file to [$out_file].\n") if (VERB1());
            } elsif ($sarg =~ /^1/) {
                $test_3j = 1;
                prt("Set to also test if a valid Three.js json file.\n") if (VERB1());
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = File::Spec->rel2abs($arg);
            prt("Set input to [$in_file]\n") if (VERB1());
        }
        shift @av;
    }

    if ($debug_on) {
        prtw("WARNING: DEBUG is ON\n");
        if ((length($in_file) ==  0) && $debug_on) {
            $in_file = $def_file;
            ##$arg = get_test_json();
            ##write2file($arg,$tmp_json);
            ##$in_file = $tmp_json;
            prt("Set DEFAULT input to [$in_file]\n");
            $load_log = 2;
            $verbosity = 9;

        }
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if (! -f $in_file) {
        pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
    }
}

sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help  (-h or -?) = This help, and exit 0.\n");
    prt(" --verb[n]     (-v) = Bump [or set] verbosity. def=$verbosity\n");
    prt(" --load        (-l) = Load LOG at end. ($outfile)\n");
    prt(" --three       (-t) = Test if a valid Three.js json (def=$test_3j)\n");
    prt(" --out <file>  (-o) = Write output to this file.\n");
}

# eof - template.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional