File Coverage

blib/lib/Test/Image/Plugin/TestingImage.pm

Criterion	Covered	Total	%
statement	20	20	100.0
branch	6	8	75.0
condition	3	3	100.0
subroutine	5	5	100.0
pod	4	4	100.0
total	38	40	95.0

package Test::Image::Plugin::TestingImage;

use strict;
# use warnings; # I want this to work with old perls!

our $VERSION = "0.01";

=head1 NAME

Test::Image::Plugin::TestingImage - for testing only

=head1 SYNOPSIS

  use Test::Image;
  my $red   = [255,0,0];
  my $green = [0,255,0];
  my $white = [255,255,255];
  test_image([
    [ $red, $red, $white, $white, $green, $green ],
    [ $red, $red, $white, $white, $green, $green ],
    [ $red, $red, $white, $white, $green, $green ],
  ]);

=head1 DESCRIPTION

This is an image designed for testing.  This defines the standard
method that you need to implement in order to provide an image.

=over

=item new

=item width

=item height

=item color_at($x,$y)

=back

See L for more details of what these should do.

=cut

sub new {
  my $class = shift;
  my $image = shift;
  return undef unless ref $image && ref $image eq "ARRAY";


  return bless {
    image  => $image,
    width  => scalar(@{ $image->[0] }),
    height => scalar(@{ $image }),
  }, $class;
}

sub width  { $_[0]->{width}  }
sub height { $_[0]->{height} }

sub color_at {
 my $self = shift;
 my $image = $self->{image};

 my $x = shift;
 my $y = shift;

 die "'$x' not a valid value for x"
   unless $x =~ /^\d+$/;

 die "'$y' not a valid value for y"
     unless $y =~ /^\d+$/;

 return unless $self->{image}->[$y][$x];
 return @{ $self->{image}->[$y][$x] };
}

=head1 BUGS

None known.

Please report any bugs you find via the CPAN RT system.
L

=head1 AUTHOR

Written by Mark Fowler, [e-mail]. Please see
L for details of how to contact me.

Copyright Fotango 2006.  All rights reserved.

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

=head1 SEE ALSO



=cut

1;