File Coverage

blib/lib/Image/Seek.pm

Criterion	Covered	Total	%
statement	14	82	17.0
branch	0	10	0.0
condition	0	5	0.0
subroutine	5	12	41.6
pod			n/a
total	19	109	17.4

package Image::Seek;

use 5.006;
use strict;
use warnings;
use Carp;

require Exporter;
use AutoLoader;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw( add_image query_id loaddb savedb cleardb
    add_image_imager add_image_imlib2 remove_id) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );

our $VERSION = '0.06';

require XSLoader;
XSLoader::load('Image::Seek', $VERSION);



sub add_image {
    my ($image, $id) = @_;
    if (UNIVERSAL::isa($image, "Imager"))        { goto &add_image_imager }
    if (UNIVERSAL::isa($image, "Image::Imlib2")) { goto &add_image_imlib2 }
    if (UNIVERSAL::isa($image, "GD::Image"))     { goto &add_image_gd }
    if (UNIVERSAL::isa($image, "Image::Magick")) { goto &add_image_magick }
    croak "Don't know what sort of image $image is";
}

sub add_image_magick {
    my ($img, $id) = @_;
    #my ($reds, $blues, $greens);

    my ($width,$height) = $img->Get('width', 'height');
    my $thumb;

    if ($width == 128 && $height == 128) {
      $thumb = $img;
    }
    else {
      $thumb = $img->Clone();
      $thumb->Scale('128x128!');
    }

    my @red = $thumb->GetPixels('map' => 'R', 'height' => 128, 'width' =>128, 'normalize' => 1);
    my $reds = join('',(map { chr($_); } @red));
    my @blue = $thumb->GetPixels('map' => 'B', 'height' => 128, 'width' =>128, 'normalize' => 1);
    my $blues = join('',(map { chr($_); } @blue));
    my @green = $thumb->GetPixels('map' => 'G', 'height' => 128, 'width' =>128, 'normalize' => 1);
    my $greens = join('',(map { chr($_); } @green));
    addImage($id, $reds, $greens, $blues);
}

sub add_image_gd {
    my ($img, $id) = @_;
    my ($reds, $blues, $greens);

    my $thumb = new GD::Image(128,128,1);
    $thumb->copyResized($img,0,0,0,0,128,128,$img->width ,$img->height);

    for my $y (0..127) {
        for my $x (0..127) {
            my ($r, $g, $b) = $thumb->rgb($thumb->getPixel($x,$y));
            $reds .= chr($r); $blues .= chr($b); $greens .= chr($g);
        }
    }
    addImage($id, $reds, $greens, $blues);
}

sub add_image_imager {
    my ($img, $id) = @_;
    my ($reds, $blues, $greens);

    my $thumb = $img->scaleX(pixels => 128)->scaleY(pixels => 128);
    for my $y (0..127) {
        my @cols = $thumb->getscanline('y' => $y);
        for (@cols) {
            my ($r, $g, $b) = $_->rgba;
            $reds .= chr($r); $blues .= chr($b); $greens .= chr($g);
        }
    }
    addImage($id, $reds, $greens, $blues);
}

sub add_image_imlib2 {
    my ($img, $id) = @_;
    my ($reds, $blues, $greens);

    my $thumb = $img->create_scaled_image(128,128);
    for my $y (0..127) {
        for my $x (0..127) {
            my ($r, $g, $b,$a) = $thumb->query_pixel($x,$y);
            $reds .= chr($r); $blues .= chr($b); $greens .= chr($g);
        }
    }
    addImage($id, $reds, $greens, $blues);
}

sub query_id {
    my $id = shift;
    my $results = shift || 10;
    queryImgID($id, $results);
    my @r = results();
    my @rv;
    unshift @rv, [shift @r, shift @r] while @r;
    @rv;
}

sub remove_id {
    my $id = shift;
    removeID($id);
}

1;
__END__