#!/usr/bin/perl

use warnings;
use strict;
#use re 'debug';

my $magic = shift;

open my $fh, "<$magic" or die;
my @lines = <$fh>;
close $fh;

my @registered_types = `./get_iana_types.pl`;
my %content_types = ();
foreach my $type (@registered_types)
{
	chomp $type;
	my ($type, $subtype) = split /\//, $type;
	push @{$content_types{$type}}, $subtype;
}

my @seen = ();

foreach my $line (@lines)
{
	if ($line =~ /^#/) { next; }
	if ($line =~ /^\s*$/) { next; }
	# MIME type is in the 4th tabs-separated field
	# Ugh, some lines have fields separated by spaces.  Worst,
	# some are separated by only one space, while a space can occur
	# in the magic signature, as long as it is preceded by a
	# backslash!

	my $mime = '';
#	if ($line =~ /^[^\t]+(?:\t+|[\t\s]{2,})[^\t]+(?:\t+|[\t\s]{2,})[^\t]+(?:\t+|[\t\s]{2,})([^\t]+?)(?:\t.*)?$/) {
	if ($line =~ /^(?:[^\s]|(?<=\\)\s)+\s+(?:[^\s]|(?<=\\)\s)+\s+(?:[^\s]|(?<=\\)\s)+\s+((?:[^\s]|(?<=\\)\s)+)(?:\s+.*)?$/) {
		$mime = $1;
		#print $line;
		#print $mime."\n";
	}
	else {
		#print STDERR "Non-matched line: $line";
		next;
	}

	$mime =~ /^(.*)\/(.*)$/;
	my $type = $1;
	my $subtype = $2;
	my $match = 0;
	my @approx = ();

	foreach my $seen (@seen) {
		if ($mime eq $seen) { $match = 1; last; }
	}
	if ($match == 1) { next; }

	push @seen, $mime;
	$match = 0;

	# If not x- subtype, make sure it is registered
	if ($subtype !~ /^x[-\.]/i) {
		foreach my $reg_subtype (@{$content_types{$type}})
		{
			if (lc($subtype) eq lc($reg_subtype)) { $match = 1; }
			elsif ($reg_subtype =~ /$subtype/)
				{ push @approx, $reg_subtype; }
		}
		if (!$match) {
			print "$mime is not a registered type; use $type/x-$subtype instead!\n";
			if (scalar(@approx) > 0) {
				print "Maybe you meant one of the following: ";
				foreach my $approx (@approx) {
					print "$type/$approx ";
				}
				print "\n";
			}
		}
	}
	else {
		# make sure there is no registered type
		$subtype =~ s/^(x[-\.])//i;
		my $prefix = $1;
		foreach my $reg_subtype (@{$content_types{$type}})
		{
			if (lc($subtype) eq lc($reg_subtype)) { $match = 1; }
			elsif ($reg_subtype =~ /$subtype/)
				{ push @approx, $reg_subtype; }
		}
		if ($match) {
			print "$mime is prefixed with $prefix, but looks like a registered type; use $type/$subtype instead.\n";
		}
		else {
			if (scalar(@approx) > 0) {
				print "Did you mean one of the following for $mime: ";
				foreach my $approx (@approx) {
					print "$type/$approx ";
				}
				print "\n";
			}
		}
	}

}