File Coverage

blib/lib/Imager/Image/Base.pm

Criterion	Covered	Total	%
statement	20	21	95.2
branch	3	4	75.0
condition	2	3	66.6
subroutine	4	4	100.0
pod	0	1	0.0
total	29	33	87.8

# -*- perl -*-

# Copyright (C) 2015 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Imager::Image::Base;

use strict;
use vars qw($VERSION);
$VERSION = '0.02';

use Imager ();

sub convert {
    my($class, $image_base) = @_;
    my($w, $h) = $image_base->get('-width', '-height');
    my $has_transparency = $class->can('_has_transparency') && $class->_has_transparency($image_base);
    my $imager = Imager->new(xsize => $w, ysize => $h, (channels => 4) x!! $has_transparency);
    for my $x (0 .. $w-1) {
	for my $y (0 .. $h-1) {
	    my $color = $image_base->xy($x, $y);
	    if ($color =~ m{^(#..)..(..)..(..)..$}) { # convert #RRRRGGGGBBBB to #RRGGBB
		$color = "$1$2$3";
	    } elsif ($color =~ m{^none$}i) {
		$color = '#00000000';
	    }
	    $imager->setpixel(x => $x, y => $y, color => $color);
	}
    }
    $imager;
}

1;

__END__