#!/usr/bin/perl -w

use strict;
use File::Spec;
use Getopt::Long;

#############################################################################
#############################################################################
# Write the Info.pm file with system specific code from Info.pm.tmpl:

# This is run by the developer, and there is no need to rerun this at build
# time.

BEGIN
  {
  chdir 'dev' if -d 'dev';
  }

# Sort order for image formats. This is just used to have more common
# (where the "more common" is currently a subjective guess by the
# author) image formats in front of the magic list.
#
# The list was setup like following: the popular image formats in the
# web (jpeg, png, gif) at the front. Microsoft formats like bmp and
# ico are probably in wider use than X11 formats like xpm and xbm. svg
# is quite different from other formats in this list as it is a vector
# format, not a raster format.
my @format_priority = qw(JPEG PNG GIF TIFF BMP ICO PPM XPM XBM SVG);
my %format_to_priority = do {
    my $priority = 0;
    map { ($_ => $priority++) } reverse @format_priority;
};

my $updir = File::Spec->updir();
my $tmpl = File::Spec->catfile("Info.pm.tmpl");
my $info_pm = File::Spec->catfile($updir,"lib", "Image", "Info.pm");
my $idir = File::Spec->catdir($updir,"lib", "Image", "Info");

GetOptions("o=s" => \$info_pm)
    or die "Usage: $0 [-o output]";

opendir(DIR, $idir) || die "Can't opendir $idir: $!";
my (@code,@desc, $desc);
for my $file (sort readdir(DIR)) {
    next unless $file =~ /^([a-zA-Z]\w*)\.pm$/;
    my $format = $1;

    open(F, File::Spec->catfile($idir, $file)) || die "Can't open '$idir/$file': $!";
    my @magic;
    my $no_magic;
    my @desc;
    while (<F>) {
	if (/^=begin\s+register\b/ ... /^=end\s+register\b/) {
	    next if /^=(begin|end)/;
	    if (/^MAGIC:\s+(.*)/) {
		push(@magic, $1);
		next;
	    }
	    elsif (/^NO MAGIC:\s+true/) {
		$no_magic = 1;
		next;
	    }
	    push(@desc, $_);
	}
    }
    if (!$no_magic) {
	die "Missing magic for $format" unless @magic;
	for (@magic) {
	    if (m:^/:) {
		push(@code, [$format_to_priority{$format}||0, qq(return "$format" if $_;)]);
	    }
	    else {
		push(@code, [$format_to_priority{$format}||0, qq(return "$format" if \$_ eq $_;)]);
	    }
	}
    }

    # trim
    shift(@desc) while @desc && $desc[0]  =~ /^\s*$/;
    pop(@desc)   while @desc && $desc[-1] =~ /^\s*$/;

    $desc .= "\n=item $format\n" unless @desc && $desc[0] =~ /^=item/;
    $desc .= "\n" . join("", @desc);

}
closedir(DIR);

my $code = "sub determine_file_format
{
   local(\$_) = \@_;
   " . join("\n   ", map { $_->[1] } sort { $b->[0] <=> $a->[0] } @code) . "
   return undef;
}
";

# Copy template to top level module with substitutions
open(TMPL, $tmpl) || die "Can't open $tmpl: $!";
open(INFO, ">$info_pm") || die "Can't create $info_pm: $!";

while (<TMPL>) {
    if (/^%%DETERMINE_FILE_FORMAT%%/) {
        $_ = $code;
    }
    elsif (/^%%FORMAT_DESC%%/) {
       $_ = $desc;
    }
    print INFO $_;
}
close(INFO);
close(TMPL);