#!/usr/bin/env perl
# check LDR/MPD files for errors.
# (c) 2019 by Dirk Jagdmann <doj@cubic.org>

use strict;

for my $fn (@ARGV)
{
    # LDraw.org Standards: File Format 1.0.2
    # http://www.ldraw.org/article/218.html

    # check file name
    if ($fn =~ /\s/)
    {
	print "${fn}: file name should not contain whitespace\n";
    }
    if (length($fn) > 255)
    {
	print "${fn}: file name should not be longer than 255 characters\n";
    }
    if ($fn =~ /([^\s\w._-]+)/)
    {
	print "${fn}: file name should not contain special characters: $1\n";
    }

    # check extension
    $fn =~ /\.(\w+)$/;
    my $ext = lc($1);
    unless($ext eq 'ldr' || $ext eq 'mpd' || $ext eq 'dat')
    {
	print "${fn}: file name extension should be ldr, mpg, dat\n";
    }

    # check for UTF-8 BOM
    if (1)
    {
	open(A, "< :raw :bytes", $fn) or die "could not open $fn";
	binmode(A);
	my $bom;
	my $r = read(A, $bom, 2); # TODO: find out why read() doesn't work
	die "could not read first two bytes of $fn: $r: $!" unless $r == 2;
	die "could not read first two bytes of $fn: $r: $!" unless length($bom) == 2;
	close(A);
	if ($bom eq "\xFE\xFF")
	{
	    print "${fn}: file should not start with UTF-8 BOM\n";
	}
    }

    open(A, "< :utf8", $fn) or die "could not open $fn";
    my $line = 0;
 inputline:
    while(<A>)
    {
	++$line;
	s/\r?\n$//; # chomp CR and NL
	s/^\s+//; # strip leading whitespace

	# check the first line
	if ($line == 1)
	{
	    if (/^0 FILE (.+)/)
	    {
		if ($ext eq 'mpd' && $1 eq 'main.ldr')
		{
		    # ok, main file in MPD can be named main.ldr
		    next;
		}
		if ($1 ne $fn)
		{
		    print "${fn}:${line}: '0 FILE' does not use file name\n";
		}
		if ($1 =~ /\s/)
		{
		    print "${fn}:${line}: file name '$1' should not contain whitespace\n";
		}
		next;
	    }
	    if ($ext eq 'mpd')
	    {
		print "${fn}:${line}: MPD file does not start with '0 FILE'\n";
	    }
	    if (/^0 .+/)
	    {
		# ok, a part description
		next;
	    }
	    print "${fn}:${line}: unexpected line type: $_\n";
	    next;
	}

	# check any remaining lines
	if (/^0 Name: (.+)/)
	{
		if ($1 =~ /\s/)
		{
		    print "${fn}:${line}: file name '$1' should not contain whitespace\n";
		}
	    if ($1 ne $fn)
	    {
		if ($ext eq 'mpd' && $line < 5 && $1 eq 'main.ldr')
		{
		    # ok, first file in MPD can be named main.ldr
		    next;
		}
		if ($ext eq 'mpd' && $line > 5)
		{
		    # ok, another sub-file in a MPD file
		    next;
		}
		print "${fn}:${line}: '$_' does not use file name\n";
	    }
	}
	elsif (/^0 FILE/)
	{
	    /^0 FILE(\s+)(.+)/;
	    if (length($1) > 1)
	    {
		print "${fn}:${line}: more than one space character used before file name\n";
	    }
	    if (length($2) < 5)
	    {
		print "${fn}:${line}: invalid file name '$2'\n";
	    }
	    if ($2 =~ /\s/)
	    {
		print "${fn}:${line}: file name '$2' should not contain whitespace\n";
	    }
	}
	# official line types: http://www.ldraw.org/article/218.html
	elsif (/^1\s+(.+)/)
	{
	    my @a = split(/\s+/, $1);
	    if (scalar(@a) != 14)
	    {
		print "${fn}:${line}: line type 1 (color) should have 14 elements\n";
	    }
	    if ($a[0] eq 24)
	    {
		print "${fn}:${line}: line type 1 (color) should not use color 24\n";
	    }
	}
	elsif (/^2\s+(.+)/)
	{
	    my @a = split(/\s+/, $1);
	    if (scalar(@a) != 7)
	    {
		print "${fn}:${line}: line type 2 (line) should have 7 elements\n";
	    }
	}
	elsif (/^3\s+(.+)/)
	{
	    my @a = split(/\s+/, $1);
	    if (scalar(@a) != 10)
	    {
		print "${fn}:${line}: line type 3 (triangle) should have 10 elements\n";
	    }
	}
	elsif (/^4\s+(.+)/)
	{
	    my @a = split(/\s+/, $1);
	    if (scalar(@a) != 13)
	    {
		print "${fn}:${line}: line type 4 (quad) should have 13 elements\n";
	    }
	}
	elsif (/^5\s+(.+)/)
	{
	    my @a = split(/\s+/, $1);
	    if (scalar(@a) != 13)
	    {
		print "${fn}:${line}: line type 5 (optional line) should have 13 elements\n";
	    }
	}
	elsif (/^0 (STEP|CLEAR|PAUSE|SAVE|NOFILE).+/)
	{
	    print "${fn}:${line}: extra stuff after $1\n";
	}
	elsif (/^0 (\!?LDRAW_ORG|Official|Un-?official)\s+(\S+)/)
	{
	    my $type = $2;
	    # http://www.ldraw.org/article/218.html
	    foreach (qw(Part Subpart Primitive 8_Primitive 48_Primitive Shortcut File Model Submodel Unofficial_Model Unofficial_Shortcut Unofficial_Subpart Unofficial_Primitive))
	    {
		next inputline if $type eq $_;
	    }
	    foreach (qw(Element Sub-part Hi-Res Alias Cross-reference))
	    {
		if ($type eq $_)
		{
		    print "${fn}:${line}: deprecated file type: $type\n";
		    next inputline;
		}
	    }
	    print "${fn}:${line}: unknown file type: $type\n";
	}
	# http://www.ldraw.org/article/340
	elsif (/^0 !CATEGORY\s+(.+)/)
	{
	    my $cat = $1;
	    # http://www.ldraw.org/library/tracker/ref/catkeyfaq/
	    foreach (qw(Animal Antenna Arch Arm Bar Baseplate Belville Boat Bracket Brick Car Clikits Cockpit Cone Constraction Constraction Accessory Container Conveyor Crane Cylinder Dish Door Electric Exhaust Fence Figure Figure Accessory Flag Forklift Freestyle Garage Glass Grab Hinge Homemaker Hose Ladder Lever Magnet Minifig Minifig Accessory Minifig Footwear Minifig Headwear Minifig Hipwear Minifig Neckwear Monorail Obsolete Panel Plane Plant Plate Platform Propellor Rack Roadsign Rock Scala Screw Sheet Cardboard Sheet Fabric Sheet Plastic Slope Sphere Staircase Sticker Support Tail Tap Technic Tile Tipper Tractor Trailer Train Turntable Tyre Vehicle Wedge Wheel Winch Window Windscreen Wing Znap))
	    {
		next inputline if $cat eq $_;
	    }
	    print "${fn}:${line}: unknown category: $cat\n";
	}
	# http://www.ldraw.org/article/415
	elsif (/^ BFC\s+($1)/)
	{
	    my $bfc = $1;
	    foreach (('NOCERTIFY', 'CERTIFY', 'CERTIFY CW', 'CERTIFY CCW', 'CW', 'CCW', 'CLIP', 'CLIP CW', 'CLIP CCW', 'NOCLIP', 'INVERTNEXT'))
	    {
		next inputline if $bfc eq $_;
	    }
	    print "${fn}:${line}: unknown BFC: $bfc\n";
	}
    }
    close(A);
}
