File Coverage

blib/lib/Labyrinth/DIUtils/ImageMagick.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Labyrinth::DIUtils::ImageMagick;
2              
3 6     6   100955 use warnings;
  6         11  
  6         239  
4 6     6   32 use strict;
  6         8  
  6         347  
5              
6             our $VERSION = '5.08';
7              
8             =head1 NAME
9              
10             Labyrinth::DIUtils::ImageMagick - Digital Image utilities driver for ImageMagick.
11              
12             =head1 SYNOPSIS
13              
14             use Labyrinth::DIUtils::ImageMagick;
15              
16             Labyrinth::DIUtils::Tool('ImageMagick');
17              
18             my $hook = Labyrinth::DIUtils::ImageMagick->new($file);
19             my $hook = $hook->rotate($degrees); # 0 - 360
20             my $hook = $hook->reduce($xmax,$ymax);
21             my $hook = $hook->thumb($thumbnail,$square);
22              
23             =head1 DESCRIPTION
24              
25             Handles the driver software for ImageMagick image manipulation; Do not use
26             this module directly, access via Labyrinth::DIUtils.
27              
28             =cut
29              
30             #############################################################################
31             #Modules/External Subroutines #
32             #############################################################################
33              
34 6     6   14838 use Image::Magick;
  0            
  0            
35              
36             #############################################################################
37             #Subroutines
38             #############################################################################
39              
40             =head1 METHODS
41              
42             =head2 Contructor
43              
44             =over 4
45              
46             =item new($file)
47              
48             The constructor. Passed a single mandatory argument, which is then used as the
49             image file for all image manipulation.
50              
51             =back
52              
53             =cut
54              
55             sub new {
56             my $self = shift;
57             my $image = shift;
58              
59             die "no image specified" if !$image;
60             die "no image file found" if !-f $image;
61              
62             # read in current image
63             my $i = Image::Magick->new();
64             die "object image error: [$image]\n" if !$i;
65             my $c = $i->Read($image);
66             die "read image error: [$image] $c\n" if $c;
67              
68             my $atts = {
69             'image' => $image,
70             'object' => $i,
71             };
72              
73             # create the object
74             bless $atts, $self;
75             return $atts;
76             }
77              
78              
79             =head2 Image Manipulation
80              
81             =over 4
82              
83             =item rotate($degrees)
84              
85             Object Method. Passed a single mandatory argument, which is then used to turn
86             the image file the number of degrees specified.
87              
88             =cut
89              
90             sub rotate {
91             my $self = shift;
92             my $degs = shift || return;
93              
94             return unless($self->{image} && $self->{object});
95              
96             my $i = $self->{object};
97             $i->Rotate(degrees => $degs);
98             $i->Set( orientation => 'top-right' );
99             $self->_writeimage($self->{image});
100              
101             return 1;
102             }
103              
104             =item reduce($xmax,$ymax)
105              
106             Object Method. Passed two arguments (defaulting to 100x100), which is then
107             used to reduce the image to a size that fit inside a box of the specified
108             dimensions.
109              
110             =cut
111              
112             sub reduce {
113             my $self = shift;
114             my $xmax = shift || 100;
115             my $ymax = shift || 100;
116             my $qual = shift || 0;
117              
118             return unless($self->{image} && $self->{object});
119              
120             my $i = $self->{object};
121             my ($width,$height) = $i->Get('columns', 'rows');
122             return unless($width > $xmax || $height > $ymax);
123              
124             # set the quality of the image, if specified
125             $i->Set( quality => $qual ) if($qual);
126              
127             $i->Scale(geometry => "${xmax}x${ymax}");
128             $self->_writeimage($self->{image});
129              
130             return 1;
131             }
132              
133             =item thumb($thumbnail,$square)
134              
135             Object Method. Passed two arguments, the first being the name of the thumbnail
136             file to be created, and the second being a single dimension of the square box
137             (defaulting to 100), which is then used to reduce the image to a thumbnail.
138              
139             =back
140              
141             =cut
142              
143             sub thumb {
144             my $self = shift;
145             my $file = shift || return;
146             my $smax = shift || 100;
147              
148             return unless($self->{object});
149              
150             my $i = $self->{object};
151             $i->Scale(geometry => "${smax}x${smax}");
152             $self->_writeimage($file);
153              
154             return 1;
155             }
156              
157             sub _writeimage {
158             my $self = shift;
159             my $file = shift;
160              
161             my $i = $self->{object};
162             return unless($i);
163              
164             my $c = $i->Write($file);
165             die "write image error: [$self->{image}] $c\n" if $c;
166             }
167              
168             1;
169              
170             __END__