view release on metacpan or  search on metacpan

Convert.pm  view on Meta::CPAN

		    my($r,$g,$b) = $im->rgb($tr_idx);
		    my $rgb = sprintf "#%02x%02x%02x", $r, $g, $b;
		    push @cmd, "-transparency", "$rgb";
		} else {
		    warn "Can't handle transperancy (yet)";
		}
	    }
	    push @cmd, "ppm:-", "gif:-";
	} else {
	    push @cmd, "png:-", "gif:-";
	}
    } else {
	die "Unhandled type $ext_type";
    }

    my $gif = _3_pipe(\$in_image, \@cmd);
    $gif;

}

sub _newFromGif_external {
    my($self, $ext_type, $source_type, $data, $truecolor) = @_;

    if ($source_type eq 'file') {
	# $data is a file name
	$data = _data_from_file($data);
    }

    my @cmd;
    my $input_type;

    if ($ext_type eq 'netpbm') {
	@cmd = ("giftopnm");
	$input_type = "pnm";
    } elsif ($ext_type eq 'imagemagick') {
	my $can_png;
	if (GD::Image->can('png')) {
	    # Prefer gif => png, because transparency information won't get
	    # lost.
	    $input_type = "png";
	    $can_png = 1;
	} else {
	    $input_type = "pnm";
	}

	@cmd = ("convert");

	if (!$can_png) {
	    push @cmd, "gif:-", "ppm:-";
	} else {
	    push @cmd, "gif:-", "png:-";
	}
    } else {
	die "Unhandled type $ext_type";
    }

    my $data2 = _3_pipe(\$data, \@cmd);

    my $cmd;
    if ($input_type eq 'png') {
	$cmd = "newFromPngData";
    } else {
	$cmd = "newFromPpmData";
    }

    my $gd;
    if ($GD::VERSION >= 2 && defined $truecolor) {
	$gd = $self->$cmd($data2, $truecolor);
    } else {
	$gd = $self->$cmd($data2);
    }
    $gd;
}

sub gif_netpbm      { shift->_gif_external("netpbm", @_) }
sub gif_imagemagick { shift->_gif_external("imagemagick", @_) }

sub newFromGif_netpbm      {
    shift->_newFromGif_external("netpbm", "file", @_);
}
sub newFromGif_imagemagick {
    shift->_newFromGif_external("imagemagick", "file", @_);
}
sub newFromGifData_netpbm      {
    shift->_newFromGif_external("netpbm", "data", @_);
}
sub newFromGifData_imagemagick {
    shift->_newFromGif_external("imagemagick", "data", @_);
}

sub _wbmp {
    my $im = shift;
    GD::Wbmp::write($im, @_);
}

sub _data_from_file {
    my $file = shift;
    no strict 'refs'; # for perl 5.00503
    my $FH;
    my $do_close;
    if (ref $file eq 'GLOB' || UNIVERSAL::isa($file, 'IO::Handle')) {
	$FH = $file;
    } else {
	no strict 'refs';
	$FH = "FH";
	open($FH, $file) or die "Can't open $file: $!";
	$do_close = 1;
    }
    local $/ = undef;
    my $data = <$FH>;
    close $FH if $do_close;
    $data;
}

sub _3_pipe {
    my($in_ref, $cmd_ref) = @_;

    warn "Cmd: @$cmd_ref\n" if $GD::Convert::DEBUG;

    if ($ENV{MOD_PERL}) {
#	return _3_pipe_ipc_run(@_); # XXX see below