package App::PNGCrush;

use warnings;
use strict;

our $VERSION = '0.001';

use Carp;
use Proc::Reliable;
use Devel::TakeHashArgs;
use base 'Class::Data::Accessor';

my %Valid_Options = qw(
    already_size            -already
    bit_depth               -bit_depth
    background              -bkgd
    brute_force             -brute
    color_type              -c
    color_counting          -cc
    output_dir              -d
    double_image_gamma      -dou
    output_extension        -e
    filter                  -f
    fix_fatal               -fix
    output_force            -force
    gamma                   -g
    itxt                    -itxt
    level                   -l 
    method                  -m
    maximum_idat            -max
    no_output               -n
    no_color_counting       -no_cc
    plte_length             -plte_len
    remove                  -rem
    replace_gamma           -replace_gamma
    resolution              -res
    save_unknown            -save
    srgb                    -srgb
    text                    -text
    transparency            -trns
    window_size             -w
    strategy                -z
    insert_ztxt             -zitxt
    ztxt                    -ztxt
    verbose                 -v
);

my %No_Arg_Options = map { $_ => 1 } qw(
    brute_force
    color_counting
    double_image_gamma
    fix_fatal
    output_force
    no_output
    no_color_counting
    save_unknown
    verbose
);

__PACKAGE__->mk_classaccessors (
    qw( proc error results ),
    keys %Valid_Options
);

sub new {
    my $self = bless {}, shift;
    get_args_as_hash( \@_, \my %args, { maxtime => 300 } )
        or croak $@;

    my $proc = Proc::Reliable->new;

    $proc->$_( $args{$_} ) for keys %args;

    $self->proc( $proc );

    return $self;
}

sub run {
    my $self = shift;
    my $in   = shift;

    get_args_as_hash( \@_, \ my %args, { in => $in }, )
        or croak $@;

    $self->$_(undef) for qw(error results);

    my @options = exists $args{opts}
                ? @{ $args{opts} }
                : $self->_make_options;

    my $proc = $self->proc;
    my %out;
    @out{ qw(stdout stderr status msg) }
    = $proc->run( [ 'pngcrush', @options, $in ] );

    return $self->_set_error("Proc::Reliable error: $out{error}")
        if defined $out{error};

    return $self->_set_error("File $in does not seem to exist")
        if $out{stdout} =~ /Could not find file: \Q$in/;

    @out{ qw(idat size) } = $out{stdout}
    =~ /\(([\d.]+)% IDAT reduction\).+?\(([\d.]+)% filesize reduction\)/s;

    $out{idat} = 0
        if not defined $out{idat}
            and $out{stdout} =~ /\Q(no IDAT change)/;

    $out{size} = 0
        if not defined $out{size}
            and $out{stdout} =~ /\Q(no filesize change)/;

    @{ $out{cpu} }{ qw(total decoding encoding other) } = $out{stdout}
    =~ /CPU \s time \s used \s = \s ([\d.]+) \s seconds \s
            \(decoding \s ([\d.]+), \s+
          encoding \s ([\d.]+), \s other \s ([\d.]+) \s seconds\)
    /x;

    ( $out{total_idat_length} ) = $out{stdout}
    =~ /Total length of data found in IDAT chunks\s+=\s+([\d.]+)/;

    return $self->results( \%out );
}

sub set_options {
    my $self = shift;
    get_args_as_hash( \@_, \my %args, {}, [], [ %Valid_Options ] )
        or croak $@;

    $self->reset_options;

    keys %args;
    my %shell_args = reverse %Valid_Options;
    while ( my ( $key, $value ) = each %args ) {
        $key = $shell_args{$key}
            unless exists $Valid_Options{$key};

        $self->$key( $value );
    }

    return 1;
}

sub reset_options {
    my $self = shift;

    $self->$_(undef) for keys %Valid_Options;

    return 1;
}

sub _make_options {
    my $self = shift;

    my @options;
    for my $opt ( keys %Valid_Options ) {
        my $value = $self->$opt;
        next
            unless defined $value;

        if ( ref $value eq 'ARRAY' ) {
            if ( $opt eq 'verbose' ) {
                push @options, ('-v') x @$value;
                next;
            }
            push @options, map { $Valid_Options{$opt} => $_ } @$value;
        }
        else {
            push @options, $Valid_Options{$opt},
                exists $No_Arg_Options{$opt} ? () : $value;
        }
    }
    return @options;
}

sub _set_error {
    my ( $self, $error ) = @_;
    $self->error($error);
    return;
}

1;
__END__

=head1 NAME

App::PNGCrush - Perl wrapper around ``pngcrush'' program

=head1 SYNOPSIS

    use strict;
    use warnings;

    use App::PNGCrush;

    my $crush = App::PNGCrush->new;

    # let's use best compression and remove a few chunks
    $crush->set_options(
        qw( -d OUT_DIR -brute 1 ),
        remove  => [ qw( gAMA cHRM sRGB iCCP ) ],
    );

    my $out_ref = $crush->run('picture.png')
        or die "Error: " . $crush->error;

    print "Size reduction: $out_ref->{size}%\n"
                . "IDAT reduction: $out->{idat}%\n";

=head1 DESCRIPTION

The module is a simple wrapper around ``pngcrush'' program. The program
is free open source and you can obtain it from
L<http://pmt.sourceforge.net/pngcrush/> on Debian systems you
can find it in the repos: C<sudo -H apt-get install pngcrush>

I needed this module to utilize only little subsection of C<pngcrush>'s
functionality, if you would like some features added, I am more than open
for suggestions.

=head1 CONSTRUCTOR

=head2 C<new>

    my $crush = App::PNGCrush->new;

    my $crush = App::PNGCrush->new( max_time => 300 );

Creates a new App::PNGCrush object. Arguments are optional and passed
as key/value pairs with keys being L<Proc::Reliable> methods and values
being the values for those methods, here you can set some options
controlling how C<pngcrush> will be run. Generally, you'd worry only
about C<max_time> (which B<defaults> to C<300> seconds in C<App::PNGCrush>)
and set it to a higher value if you are about to process large images
with brute force.

=head1 METHODS

=head2 C<run>

    my $results_ref = $crush->run('pic.png')
        or die $crush->error;

    my $results_ref = $crush->run('pic.png', opts => [ qw(custom stuff) ] );

Instructs the object to run C<pngcrush>. The first argument is mandatory
and must be a filename which will be passed to C<pngcrush> as input file.
Takes one optional argument (so far), which is passed as key/value
pair; the key being C<opts> and value being an arrayref of custom options
you want to give to C<pngcrush> (those will bypass shell proccessing).
Generally the custom options option is in here "just in case" and B<you
are recommended to set options via individual methods or C<set_options()>
method (see below).>

Returns either C<undef> or an empty list (depending on the context)
if an error occured and the reason for the error will be available via
C<error()> method. On success returns a hashref with the following
keys/values:

    $VAR1 = {
        'total_idat_length' => '1880',
        'cpu' => {
                    'decoding' => '0.010',
                    'other' => '0.050',
                    'total' => '0.210',
                    'encoding' => '0.150'
        },
        'stderr' => '',
        'status' => '0',
        'idat' => '0.80',
        'stdout' => '| pngcrush 1.6.4 .. blah blah full STDOUT here',
        'size' => '1.56'
    };

=head3 C<size>

    { 'size' => '1.56', }

The C<size> key will contain percentage of filesize reduction.

=head3 C<idat>

    { 'idat' => '0.80', }

The C<idat> key will contain the percentage of IDAT size reduction.

=head3 C<total_idat_length>

    { 'total_idat_length' => '1880', }

The C<total_idat_length> key will contain total length of data found in
IDAT chunks.

=head3 C<cpu>

    'cpu' => {
        'decoding' => '0.010',
        'other' => '0.050',
        'total' => '0.210',
        'encoding' => '0.150'
    },

The C<cpu> key will contain a hashref with with four keys:
C<total>, C<decoding>, C<other> and C<encoding> with values being
number of seconds it took to process.

=head3 C<stderr>

    { 'stderr' => '', }

The C<stderr> key will contain any collected data from STDERR while
C<pngcrush> was running.

=head3 C<stdout>

    { 'stdout' => '| pngcrush 1.6.4 .. blah blah full STDOUT here', }

The C<stdout> key will contain any collected data from STDOUT while
C<pngcrush> was running.

=head3 C<status>

    { 'status' => '0' }

The C<status> key will contain the exit code of C<pngcrush>.

=head2 C<error>

    my $ret_ref = $crush->run('some.png')
        or die $crush->error;

If C<run> failed it will return either C<undef> or an empty list depending
on the context and the reason for failure will be available via C<error()>
method. Takes no arguments, returns a human parsable error message
explaining why C<run> failed.

=head2 C<results>

    my $results_ref = $crush->results;

Must be called after a successful call to C<run()>. Takes no arguments,
returns the exact same hashref last call to C<run()> returned.

=head2 C<set_options>

    $crush->set_options(
        qw( -d OUT_DIR -brute 1 ),
        remove  => [ qw( gAMA cHRM sRGB iCCP ) ],
    );

Always returns a true value. Sets the options with which to run
C<pngcrush>. As argument takes a list of key/value pairs of
either standard C<pngcrush> options or more verbose names this module
offers (see below). If you want to B<repeat> certain option pass values
as B<an arrayref>, thus if on a command line you'd write
C<< pngcrush -rem gAMA -rem cHRM -rem sRGB ... >> you'd use
C<< ->set_options( '-rem' => [ qw( gAMA cHRM sRGB iCPP ) ] ) >>.

B<Note:> if C<pngcrush> option does not take an argument you B<must>
give it a value of C<1> when setting it via C<set_options()> method.
For C<-v> option you can set it to value C<2> to repeat twice
(aka uber verbose). B<Same applies> to individual option setting methods.

B<Note 2:> call to C<set_options()> will call C<reset_options()> method
(see below) before setting any of your options, thus whatever you
don't specify will not be passed to C<pngcrush>

=head2 C<reset_options>

    $crush->reset_options;

Always returns a true value, takes no arguments. Instructs the object
to reset all C<pngcrush> options.

=head2 individual option methods

Module provides methods to set (almost) all C<pngcrush> options individually
You'd probably would want to use C<set_options()> method (see above)
in most cases. See C<set_options()> method which describes how to
repeat options and how to set options which take no arguments in
C<pngcrush>. The following is the list of methods (on the left) and
corresponding C<pngcrush> options they set (on the right); some
options were deemed useless to the module and were not included
(this is as of C<pngcrush> version 1.6.4):

    already_size            -already
    bit_depth               -bit_depth
    background              -bkgd
    brute_force             -brute
    color_type              -c
    color_counting          -cc
    output_dir              -d
    double_image_gamma      -dou
    output_extension        -e
    filter                  -f
    fix_fatal               -fix
    output_force            -force
    gamma                   -g
    itxt                    -itxt
    level                   -l 
    method                  -m
    maximum_idat            -max
    no_output               -n
    no_color_counting       -no_cc
    plte_length             -plte_len
    remove                  -rem
    replace_gamma           -replace_gamma
    resolution              -res
    save_unknown            -save
    srgb                    -srgb
    text                    -text
    transparency            -trns
    window_size             -w
    strategy                -z
    insert_ztxt             -zitxt
    ztxt                    -ztxt
    verbose                 -v

See C<pngcrush> manpage (C<man pngcrush> or C<pngcrush -v>)
for descriptions of these options.

Out of those listed above the following C<pngcrush> options do not take
arguments,
thus to set these you'd need to pass C<1> as an argument to the option
setting method (except for C<verbose> which can take a value of C<2> to
indicate double verboseness (equivalent to passing C<-v -v> to
C<pngcrush>)

    brute_force
    color_counting
    double_image_gamma
    fix_fatal
    output_force
    no_output
    no_color_counting
    save_unknown
    verbose

=head2 C<proc>

    my $proc_reliable_obj = $crush->proc;

    $crush->proc( Proc::Reliable->new );

Returns a currently used L<Proc::Reliable> object used under the hood,
thus you could dynamically set arguments as
C<< $crush->proc->max_time(300) >>. When called with an argument
it must be a C<Proc::Reliable> object which will replace the currently
used one (and you just SOO don't wanna do this, do you?)

=head1 AUTHOR

Zoffix Znet, C<< <zoffix at cpan.org> >>
(L<http://zoffix.com>, L<http://haslayout.net>)

=head1 BUGS

Please report any bugs or feature requests to C<bug-app-pngcrush at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-PNGCrush>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc App::PNGCrush

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-PNGCrush>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/App-PNGCrush>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/App-PNGCrush>

=item * Search CPAN

L<http://search.cpan.org/dist/App-PNGCrush>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2008 Zoffix Znet, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut