#!/usr/bin/perl -w
# -*- perl -*-

#
# $Id: check_images,v 1.3 2007/09/15 17:32:11 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2002,2007 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW:  http://bbbike.de
#

# berprft, ob alle Bilder tatschlich existieren
# Wenn kein file suffix existiert, wird .gif angenommen (see below)

use strict;
use FindBin;
use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib");
use Strassen::Core;
use Object::Iterate qw(iterate);
use File::Basename;
#use Getopt::Long;

@Strassen::datadirs = ("$FindBin::RealBin/../data");

my @imagedir = ("$FindBin::RealBin/../images");
#  if (!GetOptions(
#  	       )) {
#      die "usage";
#  }

my $file = shift;

if (!$file) {
    die "File is missing";
}

my $s = Strassen->new($file) or die $!;

$file = $s->file; # absolute name
my $imgdir = dirname($file);
push @imagedir, $imgdir if -d $imgdir;

my $fail = 0;

iterate {
    my $cat = $_->[Strassen::CAT];
    if ($cat =~ /IMG:([^|]+)/) {
	my $f = $1;
    TRY: {
	    if ($f !~ m{^\.(gif|png|xpm|jpg)$}) {
		foreach my $dir (@imagedir) {
		    last TRY if (-e "$dir/$f.gif");
		    last TRY if (-e "$dir/$f.png"); # we're modern and also accept PNGs
		}
	    }
	    # suffix probably already there
	    foreach my $dir (@imagedir) {
		last TRY if (-e "$dir/$f");
	    }
	    warn "Can't find IMG $f\n";
	    $fail++;
	}
    }
} $s;

exit($fail);
