# Merge two MimeMap files
# $Debugging=1;
$Verbose=1;
die "Syntax: MimeMerge <file one> <file two> <output>\n" unless $#ARGV=3;

($one,$two,$finalout) = @ARGV[0..2];
die "Syntax: MimeMerge <file one> <file two> <output>\n" if($one eq '' or $two eq '' or $finalout eq '');


$out=$ENV{'Wimp$Scrap'};

die "No such file as $one: $!\n" unless open one;
die "No such file as $two: $!\n" unless open two;

while(<one>){
    if(/^([^#]\S+)\s+(\S*)\s+(\S*)\s+([^\n]*)$/){
        push(@one_mime,$1);
        $one_name{$1}=$2;
        $one_type{$1}=$3;
        $one_ext{$1}=join("\t",sort(split(/\s+/,$4)));
        print $one_ext{$1},"\n" if $Debugging;
    }
}
close one;
print "---\n" if $Debugging;
while(<two>){
    if(/^([^#]\S+)\s+(\S*)\s+(\S*)\s+([^\n]*)$/){
        push(@two_mime,$1);
        $two_name{$1}=$2;
        $two_type{$1}=$3;
        $two_ext{$1}=join("\t",sort(split(/\s+/,$4)));
        print $two_ext{$1},"\n" if $Debugging;
    }
}
close two;
$diff=0;
foreach $mime (@two_mime){
    if(not exists $one_name{$mime}){
        $diff=1;
        foreach $m (@one_mime){
            if(uc($m) eq uc($mime)){
                print "$mime is here actually with case off\n" if $Debugging;
                $diff=0;
            }
        }
        if($diff==1){
        print "$mime not defined in file one\n" if $Verbose;
        push @one_mime,$mime;
        $one_name{$mime}=$two_name{$mime};
        $one_type{$mime}=$two_type{$mime};
        $one_ext{$mime}=$two_ext{$mime};
        }
    } elsif(uc($one_ext{$mime}) ne uc($two_ext{$mime})){
        $diff=1;
        @tempa=split(/\s+/,$one_ext{$mime});
        @tempb=split(/\s+/,$two_ext{$mime});
        foreach $b (@tempb){
            print $b,":" if $Debugging;
            $y=0;
           foreach $a (@tempa){
               print "\t",$a if $Debugging;
               if((uc($a) cmp uc($b))==0){$y=1};
               print " - ",$y,"\n" if $Debugging;
           }
           if($y==0){
               print "Extension $b not found in mime-type $mime in file one\n" if $Verbose;
               push @tempa,$b;
               $diff=1;
           }
        }
        $one_ext{$mime}=join("\t",sort @tempa);
    }
}
 
if($diff==0){
    print "File one contains everything that file two contains - you may copy file one over file two safely\n";
    exit;
}

$outt=$out;
$out='>'.$out;
die "Unable to write to $out: $!\n" unless open out;
print out <<END;
# Mapping of content types to file types
#
# Lines starting with a '#' are comments, blank lines are ignored.
#
# A '*' is a wild before or after the / or for the RISC OS file type
# The first match that does not map to a wildcard is the one that is used.
#
# If the file type name is not known but a hex value is given that type
# is used, otherwise it is not considered a match.
#
END

# Reverse sort so asterisks go to end (now also takes asterisks in filetypes # and hex-types into account
sub special_sort {
    return 1 if ($a=~/^\*.*/);
    return -1 if ($b=~/^\*.*/);
    return 1 if($one_name{$a} eq "*" or $one_type{$a} eq "*");
    return -1 if($one_name{$b} eq "*" or $one_type{$b} eq "*");
    return $b cmp $a;
}

@one_mime = sort special_sort @one_mime;

@one_mime = ("# MIME type/subtype",@one_mime);
$one_name{"# MIME type/subtype"}="RISC OS name";
$one_type{"# MIME type/subtype"}="Hex";
$one_ext{"# MIME type/subtype"}="Extensions";

$bigmime=0;
$bigname=0;
$bigtype=0;
$bigext=0;

foreach $mime (@one_mime){
    $bigmime=length $mime if length $mime>$bigmime;
    $bigname=length $one_name{$mime} if length $one_name{$mime}>$bigname;
    $bigtype=length $one_type{$mime} if length $one_type{$mime}>$bigtype;
    $bigext=length $one_ext{$mime} if length $one_ext{$mime}>$bigext;
}

$format = "format out = \n".'@'.('<' x ($bigmime+1)).'@'.('<' x ($bigname+1)).'@'.('<' x ($bigtype+1)).'@'.('<' x ($bigext+1))."\n".'$mime,$one_name{$mime},$one_type{$mime},$one_ext{$mime}'."\n".".\n";
print $format if $Debugging;
eval $format;
die $@ if $@;

$last=(split(/\//,$one_mime[0]))[0];

foreach $mime (@one_mime){
    print out "\n" if $last ne (split(/\//,$mime))[0];
    write out;
    $last=(split(/\//,$mime))[0];
}
close out;

#Eliminate phantom duplicate lines...
$out=$outt;
$finalout='>'.$finalout;
open out;
open finalout;
$one=<out>;
while($two=<out>){
    if($one ne $two){
        print finalout $one;
        $one=$two;
    }
}
print finalout $one;
close out;
close finalout;
