#!/opt/local/bin/perl5.34

use warnings;
use strict;
use Image::PNG::Libpng ':all';
use Data::Dumper;
use Getopt::Long;

my $ok = GetOptions (
    json => \my $json,
    verbose => \my $verbose,
);

if (! $ok) {
    print <<EOF;

pnginspect: valid options are

--json         Output JSON
--verbose      Print messages

EOF
    exit;
}


# Ok to connect to web?

my $web_ok = eval {
    require Data::Validate::URI;
    Data::Validate::URI->import (qw/is_web_uri/);
    require LWP::Simple;
    LWP::Simple->import ();
    1;
};

my $json_ok = eval {
    require JSON::Create;
    JSON::Create->import ();
    1;
};

if ($json && ! $json_ok) {
    die "Install JSON::Create to use the --json option";
}

binmode STDOUT, ":encoding(utf8)";

for my $file (@ARGV) {
    my $png;
    my $size;
    if (-f $file) {
	eval {
	    $png = read_png_file ($file);
	};
	if ($@) {
	    warn "Could not read '$file': $@";
	    next;
	}
	$size = -s $file;
    }
    else {
	if ($verbose) {
	    print "Cannot find $file on this filesystem, web link?\n";
	}
	if ($web_ok) {
	    if ($verbose) {
		print "Checking if $file looks like a URI.\n";
	    }
	    if (is_web_uri ($file)) {
		if ($verbose) {
		    print "Getting '$file' from web.\n";
		}
		my $png_data = get ($file);
		if ($png_data) {
		    $png = read_from_scalar ($png_data);
		    $size = length ($png_data);
		}
		else {
		    warn "Could not download '$file', skipping.\n";
		    next;
		}
	    }
	    else {
		warn "Cannot find a file called '$file', skipping.\n";
		next;
	    }
	}
	else {
	    warn "Modules needed to read from web not installed";
	    next;
	}
    }
    my $contents = get_contents ($png, $file, $size);
    if ($json) {
	die "JSON output is not implemented";
    }
    else {
	print_text ($contents);
    }
}

sub print_text
{
    my ($contents) = @_;

    print "Contents of '$contents->{name}':\n\n";
    print "File size: $contents->{size} bytes\n\n";
    # Print the header first
    print_header ($contents->{ihdr});
    for my $key (sort keys %$contents) {
	if ($key =~ /^(name|size|ihdr|text)$/) {
	    # Already printed above, or below in the case of 'text'.
	    next;
	}
	my $chunk = $contents->{$key};
	if (! $chunk) {
	    next;
	}
	print "* Valid $key chunk";
	if ($key eq 'IDAT') {
	    print " (image data - omitted).\n";
	    next;
	}
	if ($key eq 'tIME') {
	    my $time = $chunk;
	    print " - image modification time is:\n";
	    for my $k (qw/year month day hour minute second/) {
		print "$k: $time->{$k}\n";
	    }
	    next;
	}
	if ($key eq 'PLTE') {
	    printf " containing %d colours as follows (RGB in hexadecimal):\n",
	        scalar (@$chunk);
	    print_PLTE ($chunk);
	    print "\n";
	    next;
	}
	if ($key eq 'tRNS') {
	    my $trns = $chunk;
	    printf " containing %d values as follows:\n",
	    scalar (@$trns);
	    my $dtrns = join ", ", @$trns;
	    print "$dtrns\n";
	    next;
	}
	if ($key eq 'iCCP') {
	    my $iccp = $chunk;
	    print "\n";
	    print "name: $iccp->{name}\n";
	    print "profile (binary data in hex) :\n";
	    print_binary_data ($iccp->{profile});
	    next;
	}
	# Default
	print " as follows:\n";
	print Dumper ($chunk);
    }
    my $text = $contents->{text};
    if ($text) {
	my $i = 0;
        for my $t (@$text) {
	    $i++;
            print "Text chunk $i:\n";
            for my $k (sort keys %$t) {
                my $v = $t->{$k};
                if (! defined $v) {
                    $v = 'undefined';
                }
		if ($k eq 'compression') {
		    $v = text_compression_name ($v);
		}
                print "$k: $v\n";
            }
            print "\n";
        }
    }
    print "\n";
}

sub print_PLTE
{
    my ($plte) = @_;
    my $col = 10;
    my $i = 0;
    for my $rgb (@$plte) {
	printf "#%02X%02X%02X ", $rgb->{red}, $rgb->{green}, $rgb->{blue};
	$i++;
	if (($i % $col) == 0) {
	    print "\n";
	}
    }

}

sub print_binary_data
{
    my ($data) = @_;
    my $cols = 10;
    my $l = length ($data);
    my $column = 0;
    for my $i (0..$l-1) {
	my $byte = substr ($data, $i, 1);
	printf "%02X ", ord ($byte);
	$column++;
	if ($column > $cols) {
	    print "\n";
	    $column = 0;
	}
    }
    if ($column != 0) {
	print "\n";
    }
}

sub print_header
{
    my ($ihdr) = @_;
    for my $k (sort keys %$ihdr) {
	# Display key
	my $dk = $k;
	$dk = ucfirst ($dk);
	$dk =~ s/_/ /g;
	print "$dk: ";
	if ($k eq 'color_type') {
	    print color_type_name ($ihdr->{$k});
	}
	elsif ($k eq 'interlace_method') {
	    # Interlace method
	    my $im = $ihdr->{$k};
	    # Displayed interlace method
	    my $dim = 'Unknown';
	    if ($im == 0) {
		$dim = 'None';
	    }
	    elsif ($im == 1) {
		$dim = 'ADAM7';
	    }
	    print $dim;
	}
	else {
	    print $ihdr->{$k};
	}
	print "\n";
    }
}

__END__

=pod

=head1 NAME

pnginspect - print contents of PNG files

=head1 SYNOPSIS

    pnginspect a.png b.png c.png

=head1 DESCRIPTION

Print a text representation of the data within a PNG image file to
standard output. It reads the PNG file, prints out its header
information and its valid chunks, and then attempts to read all the
chunks. Most of the chunks are printed using
L<Data::Dumper>. Modification time and text segments are printed
specially.

The image data is not currently printed out.

If you have L<Data::Validate::URI> and L<LWP::Simple> installed, you
can also use it to examine PNG files on the web, like this:

    pnginspect http://libpng.org/pub/png/img_png/libpng-88x31.png

These modules are not installed automatically by Image::PNG::Libpng,
so please install them yourself if you would like to use this
facility.

=head1 OPTIONS

=over

=item --verbose

Print verbose information for debugging.

=back

=head1 SEE ALSO

=over

=item L<Image::PNG::Libpng>

=back

=head1 AUTHOR

Ben Bullock <bkb@cpan.org>

=cut

# Local variables:
# mode: perl
# End:
