Image-IPTCInfo-RasterCaption

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
    'NAME'		=> 'Image::IPTCInfo::RasterCaption',
    'VERSION_FROM'	=> 'RasterCaption.pm', # finds $VERSION
    'PREREQ_PM'		=> {
		"Image::Magick"		=> 0.1,
		"Image::IPTCInfo"	=> 1.6,
	},
    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
      (ABSTRACT_FROM => 'RasterCaption.pm', # retrieve abstract from module
       AUTHOR     => 'Lee Goddard <lgoddard@cpan.org>') : ()),
);

README  view on Meta::CPAN

   make install

The tests are pretty basic, since I'm not giving
away image recognition technology ;)

DEPENDENCIES

This module requires these other modules and libraries:

  Image::IPTCInfo
  Image::Magick

COPYRIGHT AND LICENCE

Put the correct copyright and licence information here.

Copyright (C) 2003 Lee Goddard

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

RasterCaption.pm  view on Meta::CPAN

package Image::IPTCInfo::RasterCaption;

use vars qw/$VERSION/;
$VERSION = 0.1;

=head1 NAME

Image::IPTCInfo::RasterCaption - get/set IPTC raserized caption w/Image::Magick

=head1 SYNOPSIS

	use Image::IPTCInfo::RasterCaption;

	# Access the raw rasterized caption field:
	$info = new Image::IPTCInfo::RasterCaption
		('C:/new_caption.jpg')
		or die "No raster caption!";
	$raw_raster_caption = $info->Attribute('rasterized caption');

RasterCaption.pm  view on Meta::CPAN

	Not repeatable, 7360 octets, consisting of binary data,one bit
	per pixel,two value bitmap where 1 (one) represents black and
	0 (zero) represents white.

	     -- IPTC-NAA Information Interchange Model Version No. 4,
	        October 1997, Page 41


=cut

use Image::Magick;
use Image::IPTCInfo;
push @ISA, 'Image::IPTCInfo';

use Carp;
use strict;

# Add the rasterized caption to the Image::IPTCInfo dataset
$Image::IPTCInfo::datasets{125} = 'rasterized caption';
$Image::IPTCInfo::RasterCpation::datasets{125} = 'rasterized caption';


#
# SUB _blank_canvas
# 	Returns a plain white canvas of the standard size
#
sub _blank_canvas {
	my $image = new Image::Magick;
    $image = Image::Magick->new;
    $image->Set(size=>'460x128');
    $image->ReadImage('xc:white');
	return $image;
}


#
# SUB _get_raster_caption
#	ACCEPTS an image magick object and threshold value.
#	RETURNS a scalar representing the bits

RasterCaption.pm  view on Meta::CPAN

	return pack('B*', $iptc)
}


=head1 METHOD save_raster_caption

Writes to the file specified in the sole argument
the rasterized caption stored in the object's IPTC
field of the same name.

Image creation is via C<Image::Magick> so see L<Image::Magick>
for further details.

On failure returns C<undef>.

On success returns the path written to.

=cut

sub save_raster_caption { my ($self,$path) = (shift, shift);
	croak "No path!" if not $path;

RasterCaption.pm  view on Meta::CPAN

On success returns a referemce to a scalar containing
the rasterized caption.

=cut

sub load_raster_caption { my ($self,$path,$threshold) = (shift, shift,shift);
	croak "load_raster_caption requires a 'path' paramter" if not $path;
	$threshold = 127 if not defined $threshold;
	croak "Threshold param must be 1-255" if $threshold<1 or $threshold>255;
	my $image = new Image::Magick;
	my $err = $image->Read($path);
	if ($err){
		carp "Could not read file $path: $!";
		return undef;
	}
	$image->Quantize(colorspace=>'gray');
	$image->Set("monochrome"=>1);
	$image->Resize(geometry=>'460x128');
	my $iptc = _get_raster_caption($image,$threshold);
	$self->SetAttribute('rasterized caption',  $iptc);

RasterCaption.pm  view on Meta::CPAN

=head1 METHOD set_raster_caption

Fills the rasterized caption with binary data representing
supplied text.

This is very elementry: no font metrics what so ever,
just calls C<Image::Magick>'s C<Annotate>
with the text supplied in the first argument, using the
point size specified in the second argument, and the font
named in the third.

If no size is supplied, defaults to 12 points.

If no font is supplied, then C<arialuni.ttf> is looked
for in the C<fonts> directory beneath the directory specified
in the environment variable C<SYSTEMROOT>. Failing that, the
ImageMagick default is used - YMMV. See the I<Annotate> method
in L<Image::Magick> (C<imagemagick.org>) for details.

On failure carps and returns C<undef>

On success returns a referemce to a scalar containing
the rasterized caption.

=cut

sub set_raster_caption { my ($self,$text,$size,$font) = (@_);
	my $image = &_blank_canvas;

t/add.t  view on Meta::CPAN

print "1..5\n";
chdir "t";
use Image::IPTCInfo::RasterCaption;
use Image::Magick;
use strict;

# Load the binary rasterized caption from an image:
my $iptc = create Image::IPTCInfo::RasterCaption('has_caption.jpg');
unless ($iptc){
	print "not ok 1\nnot ok 2\nnot ok 3\n";
	exit;
}
print "ok 1\n";

# Get caption from image
$iptc->load_raster_caption('has_caption.jpg');
my $rasterized_caption_data = $iptc->Attribute('rasterized caption');

if ($rasterized_caption_data){
	print "ok 2\n";
} else {
	print "not ok 2\n";
}

my $new_im = new Image::Magick;
$new_im->Set(size=>'460x128');
$new_im->ReadImage('xc:white');
if ($new_im->Write('no_caption.jpg')){
	print "not ok 3\n";
} else {
	print "ok 3\n";
}

t/text.t  view on Meta::CPAN

print "1..7\n";

use Image::IPTCInfo::RasterCaption;
use Image::Magick;
use strict;
chdir "t";

# Load the binary rasterized caption from an image:
my $iptc = create Image::IPTCInfo::RasterCaption('has_caption.jpg');
unless ($iptc){
	for (1..7){
		print "not ok $_\n"
	}
	exit;

t/text.t  view on Meta::CPAN

# Get caption from image
$iptc->load_raster_caption('has_caption.jpg');
my $rasterized_caption_data = $iptc->Attribute('rasterized caption');

if ($rasterized_caption_data){
	print "ok 2\n";
} else {
	print "not ok 2\n";
}

my $new_im = new Image::Magick;
$new_im->Set(size=>'460x128');
$new_im->ReadImage('xc:white');
if ($new_im->Write('no_caption.jpg')){
	print "not ok 3\n";
} else {
	print "ok 3\n";
}