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>') : ()),
);
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;
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";
}
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;
# 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";
}
( run in 0.622 second using v1.01-cache-2.11-cpan-beeb90c9504 )