The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;
use warnings;
use Panotools::Script;
use File::Spec;
use File::Temp;
use Pod::Usage;

my $path_pto = shift or pod2usage (-verbose => 2);

my $pto = new Panotools::Script;
$pto->Read ($path_pto);

for my $image (@{$pto->Image})
{
    my $n = $image->{n};
    $n =~ s/"//g;
    my ($v, $d, $path_photo) = File::Spec->splitpath ($n);
    next if -e $path_photo;

    my $pnm = new File::Temp (UNLINK => 1, SUFFIX => '.pnm');
    my $r = 64 + int(rand(128));
    my $g = 64 + int(rand(128));
    my $b = 64 + int(rand(128));
    print $pnm "P3\n# CREATOR: $0\n1 1\n255\n$r\n$g\n$b";

    next unless $image->{w} =~ /^[0-9]+$/;
    next unless $image->{h} =~ /^[0-9]+$/;
    system ('convert',
            '-geometry', $image->{w}.'x'.$image->{h}.'!',
            $pnm, $path_photo);
}

__END__

=head1 NAME 

ptodummy - create missing input photos

=head1 SYNOPSIS

  ptodummy project.pto

=head1 DESCRIPTION

B<ptodummy> takes a .pto project and creates missing input photos as
necessary.  Each input photo is filled with a different colour to
help identify them in the hugin preview or in the stitched output.

This is useful for debugging failing .pto projects submitted in bug
reports, as the original photos are not necessary to open and stitch
the project in hugin.

The created images will always be placed in the current working
directory regardless of any paths specified in the project,
pre-existing files will not be clobbered.

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

=head1 SEE ALSO

L<http://hugin.sourceforge.net/>

=head1 AUTHOR

Bruno Postle - July 2009.

=cut