File Coverage

blib/lib/Image/JpegMinimal.pm
Criterion Covered Total %
statement 17 94 18.0
branch 1 24 4.1
condition 0 39 0.0
subroutine 6 14 42.8
pod 3 9 33.3
total 27 180 15.0


line stmt bran cond sub pod time code
1             package Image::JpegMinimal;
2 1     1   19153 use strict;
  1         2  
  1         24  
3 1     1   1275 use Imager;
  1         45656  
  1         8  
4 1     1   74 use Carp qw(croak carp);
  1         7  
  1         54  
5 1     1   914 use MIME::Base64 'encode_base64';
  1         8173  
  1         70  
6              
7 1     1   8 use vars '$VERSION';
  1         2  
  1         1252  
8             $VERSION = '0.02';
9              
10             =head1 NAME
11              
12             Image::JpegMinimal - create JPEG previews without headers
13              
14             =head1 SYNOPSIS
15              
16             my $compressor = Image::JpegMinimal->new(
17             xmax => 42,
18             ymax => 42,
19             jpegquality => 20,
20             );
21              
22             sub gen_img {
23             my @tags;
24             for my $file (@_) {
25             my $imager = Imager->new( file => $file );
26             my $preview = $compressor->data_preview( $file );
27             my ($w, $h ) = ($imager->getwidth,$imager->getheight);
28            
29             my $html = <
30            
31             data-preview="$preview"
32             src="$file"
33             />
34             HTML
35             push @tags, $html;
36             };
37            
38             return @tags
39             }
40              
41             # This goes into your HTML
42             print join "\n", gen_img(@ARGV);
43              
44             # The headers accumulate in $compressor
45             my %headers = $compressor->headers;
46            
47             # This goes into your Javascript
48             print $headers{l};
49             print $headers{p};
50              
51             =head1 DESCRIPTION
52              
53             This module implements the ideas from
54             L
55             to create the data needed for inline previews of images that can be served
56             within the HTML page while keeping a low overhead of around 250 bytes per
57             image preview. This is achieved by splitting up the preview image into
58             a JPEG header which is common to all images and the JPEG image data.
59             With a Javascript-enabled browser, these previews will be shown until
60             the request for the real image has finished loading the data. This reduces
61             the latency and bandwidth needed until the user sees an image.
62              
63             It turns the following image
64              
65             =for html
66            
67            
68              
69             into 250 bytes of image data representing this image:
70              
71             =for html
72            
73            
74              
75             The Javascript on the client side then scales and blurs that preview
76             image to create a very blurry placeholder until the real image data
77             arrives from the server.
78              
79             =for html
80            
81            
82              
83             See below for the Javascript needed to reassemble the image data
84             from the split header and scan data.
85              
86             =head1 METHODS
87              
88             =head2 C<< Image::JpegMinimal->new( %OPTIONS ) >>
89              
90             my $compressor = Image::JpegMinimal->new(
91             xmax => 42,
92             ymax => 42,
93             jpegquality => 20,
94             );
95              
96             Creates a new compressor object. The C and C values
97             give the maximum dimensions for the size of the preview image.
98             It is suggested that the preview image is heavily blurred when
99             presenting the preview image to the user to hide the JPEG artifacts.
100              
101             =cut
102              
103             sub new {
104 1     1 1 21 my( $class, %options ) = @_;
105              
106             # We really need Jpeg-support
107             croak "We really need jpeg support but your version of Imager doesn't support it"
108 1 50       12 unless $Imager::formats{'jpeg'};
109              
110 0   0       $options{ jpegquality } ||= 20;
111 0   0       $options{ xmax } ||= 42;
112 0   0       $options{ ymax } ||= 42;
113              
114 0           bless \%options => $class
115             }
116              
117             sub get_imager {
118 0     0 0   my( $self, $file ) = @_;
119             # We should check that Imager can write jpeg images
120 0 0         Imager->new( file => $file )
121             or croak "Couldn't read $file: " . Imager->errstr();
122             }
123              
124             sub compress_image {
125 0     0 0   my( $self, $file, $xmax, $ymax, $jpegquality ) = @_;
126 0   0       $xmax ||= $self->{xmax};
127 0   0       $ymax ||= $self->{ymax};
128 0   0       $jpegquality ||= $self->{jpegquality};
129 0           my $imager = $self->get_imager( $file );
130            
131             # Rotate if EXIF data indicates portrait, this wrecks our headers,
132             # so disabled :-((
133             # We need two headers, one for portrait and one for landscape
134 0 0         if( my $orientation = $imager->tags(name => 'exif_orientation')) {
135 0           my %rotate = (
136             1 => 0,
137             #2 => 180,
138             3 => 180,
139             #4 => 0,
140             #5 => 90,
141             6 => 270,
142             #7 => 0,
143             8 => 90,
144             );
145 0           my $deg = $rotate{ $orientation };
146 0           $imager = $imager->rotate( right => $deg );
147             };
148            
149             # Resize
150 0 0         $imager = $imager->scale(xpixels=> $xmax, ypixels=> $ymax, type=>'min')
151             or die Imager->errstr;
152             # Write with Q20
153 0           $imager->write(type => 'jpeg', data => \my $data, jpegquality => $jpegquality);
154              
155             # Debug output for checking the original and reconstruction
156             # of the image data in base64
157             #(my $data64 = encode_base64($data)) =~ s!\s+!!g;
158             #print $data64,"\n";
159            
160 0           my( $width,$height ) = ($imager->getheight, $imager->getwidth);
161 0           return ($width,$height,$data);
162             }
163              
164             sub strip_header {
165 0     0 0   my( $self,$width,$height,$jpeg ) = @_;
166            
167             # Deparse the JPEG file into its sections
168             # Maybe some other module already provides a JPEG header parser?
169 0           my @sections;
170 0           while($jpeg =~ /\G(((\x{ff}[^\0\x{d8}\x{d9}])(..))|\x{ff}\x{d8}|\x{ff}\x{d9})/csg) {
171 0   0       my $header = $3 || $1;
172 0           my $payload;
173 0 0         if( $header eq "\x{ff}\x{da}" ) {
    0          
    0          
174             # Start of scan
175 0           $payload = substr( $jpeg, pos($jpeg)-2, length($jpeg)-pos($jpeg)+2);
176 0           pos($jpeg) = pos($jpeg) + length $payload;
177             } elsif( $header eq "\x{ff}\x{d8}" ) {
178             # Start of image
179 0           $payload = "";
180             } elsif( $header eq "\x{ff}\x{d9}" ) {
181             # End of Image
182 0           $payload = "";
183             } else {
184 0           my $length = unpack "n", $4;
185 0           $payload = substr( $jpeg, pos($jpeg)-2, $length );
186 0           pos($jpeg) = pos($jpeg) + $length -2;
187             };
188 0           push @sections, { type => $header, payload => $payload }
189             };
190              
191 0           my %priority = (
192             "\x{ff}\x{d8}" => 0,
193             "\x{ff}\x{c4}" => 1,
194             "\x{ff}\x{db}" => 2,
195             "\x{ff}\x{c0}" => 50,
196             "\x{ff}\x{da}" => 98,
197             "\x{ff}\x{d9}" => 99,
198             );
199            
200             # Only keep the important sections
201 0           @sections = grep { exists $priority{ $_->{type}}} @sections;
  0            
202             # Reorder them so that the image dimensions are at the end
203 0           @sections = sort {$priority{$a->{type}} <=> $priority{$b->{type}}} @sections;
  0            
204            
205             #for my $s (@sections) {
206             # print sprintf "%02x%02x - %04d\n", unpack( "CC", $s->{type}), length $s->{payload};
207             #};
208              
209             # Reassemble the (relevant) sections
210             my $header = join "",
211 0           map { $_->{type}, $_->{payload }}
212 0 0         grep { $_->{type} ne "\x{ff}\x{da}" and $_->{type} ne "\x{ff}\x{d9}" }
  0            
213             @sections;
214            
215             my $payload = join "",
216 0           map { $_->{type}, $_->{payload }}
217 0 0         grep { $_->{type} eq "\x{ff}\x{da}" or $_->{type} eq "\x{ff}\x{d9}" }
  0            
218             @sections;
219              
220 0           my $min_header = $header;
221            
222             # Do the actual packing
223 0           my $stripped = pack "CCA*", $width, $height, $payload;
224              
225 0           ($stripped,$min_header)
226             };
227              
228             sub btoa {
229 0     0 0   my( $self, $data ) = @_;
230 0           (my $res64 = encode_base64($data)) =~ s!\s+!!g;
231 0           $res64
232             }
233              
234             sub split_image {
235 0     0 0   my( $self, $file, $xmax, $ymax ) = @_;
236 0   0       $xmax ||= $self->{xmax};
237 0   0       $ymax ||= $self->{ymax};
238            
239 0           my($width,$height, $data) = $self->compress_image( $file, $xmax, $ymax );
240 0           my $orientation = $self->get_orientation( $width, $height );
241 0           my( $payload, $min_header ) = $self->strip_header( $width,$height,$data );
242 0   0       $self->{header}->{$orientation} ||= $self->btoa( $min_header );
243            
244             carp "Inconsistent header data"
245 0 0         if $self->{header}->{$orientation} ne $self->btoa( $min_header );
246 0           return ($payload, $min_header)
247             };
248              
249             =head2 C<< $compressor->data_preview >>
250              
251             my $data_preview = $compressor->data_preview( $file );
252              
253             Reads the JPEG data from a file and returns a base64 encoded string of
254             the reduced image data. You stuff this into the C<< data-preview >>
255             attribute of the C<< img >> tag in your HTML.
256              
257             =cut
258              
259             sub data_preview {
260 0     0 1   my( $self, $file, $xmax, $ymax ) = @_;
261 0   0       $xmax ||= $self->{xmax};
262 0   0       $ymax ||= $self->{ymax};
263            
264 0           my( $payload, $min_header ) = $self->split_image( $file, $xmax, $ymax );
265            
266 0           my $payload64 = $self->btoa($payload);
267              
268 0           return $payload64;
269             }
270              
271             sub get_orientation {
272 0     0 0   my( $self, $w, $h ) = @_;
273 0 0         if( $w < $h ) {
274 0           return 'p' # portrait
275             } else {
276 0           return 'l' # landscape
277             };
278             };
279              
280             =head2 C<< $compressor->headers >>
281              
282             my %headers = $compressor->headers;
283              
284             After processing all files, this method
285             returns the headers that are common to the images.
286             You need to pass this to your Javascript.
287              
288             =cut
289              
290             sub headers {
291 0     0 1   my( $self, $file, $xmax, $ymax ) = @_;
292 0   0       $xmax ||= $self->{xmax};
293 0   0       $ymax ||= $self->{ymax};
294            
295 0 0         if( 2 != scalar values %{ $self->{ header }}) {
  0            
296             # We need to extract at least one header from the image
297 0           my( $data, $header) = $self->split_image( $file, $xmax, $ymax );
298             # sets one entry in $self->{header} as a side effect
299             };
300            
301 0           %{ $self->{header} };
  0            
302             }
303              
304             =head1 HTML
305              
306             Each image that has a pre-preview placeholder will need to store the
307             placeholder data in the C<< data-preview >> attribute. That is all
308             the modification you need. You should also set the C<< width >>
309             and C<< height >> attributes of the image so that no ugly image-popping
310             occurs when the real data arrives. The C<< $payload64 >> is the data
311             that is returned from the C<< ->data_preview >> call.
312              
313            
314             data-preview="$payload64"
315             src="$file"
316             />
317              
318             =head1 JAVASCRIPT
319              
320             You will need to include some Javascript like the following in your
321             page, preferrably near the end so the code runs right after
322             the HTML has loaded completely but image loading has not yet fired.
323              
324             The hash C<%headers> should be set to the base64
325             encoded fixed headers as returned by the C<< ->headers( $file ) >> call.
326             The image HTML should have been constructed as outlined above.
327              
328             "use strict";
329              
330             var header = {
331             l : atob("$headers{l}"),
332             h : atob("$headers{p}"),
333             };
334             function reconstruct(data) {
335             // Reconstruct a JPEG header from our special data structure
336             var raw = atob(data);
337             // Keep as "char" so we don't have to bother with Unicode vs. ASCII
338             var width = raw.charAt(0);
339             var height = raw.charAt(1);
340             var payload = raw.substring(2,raw.length);
341             var head;
342             if( width < height ) {
343             head = header["p"]
344             } else {
345             head = header["l"]
346             };
347             var dimension_patch = width+height;
348             var patched_header = head.substring(0,head.length-13)
349             + width
350             + head.substring(head.length-12,head.length-11)
351             + height
352             + head.substring(head.length-10,head.length);
353             var reconstructed = patched_header+payload;
354             var encoded = "data:image/jpeg;base64,"+btoa(reconstructed);
355             return encoded;
356             }
357              
358             var image_it = document.evaluate("//img[\@data-preview]",document, null, XPathResult.ANY_TYPE, null);
359             var images = [];
360             var el = image_it.iterateNext();
361             while( el ) {
362             images.push(el);
363             el = image_it.iterateNext();
364             };
365              
366             for( var i = 0; i < images.length; i++ ) {
367             var el = images[ i ];
368             if( !el.complete || el.naturalWidth == 0 || el.naturalHeight == 0) {
369            
370             var fullsrc = el.src;
371             var loadsrc = reconstruct( el.getAttribute("data-preview"));
372             var container = document.createElement('div');
373             container.style.overflow = "hidden";
374             container.style.display = "inline";
375             container.style.position = "relative";
376              
377             var parent = el.parentNode;
378             parent.insertBefore(container, el);
379             container.appendChild(el);
380              
381             // Set up the placeholder data
382             el.src = loadsrc;
383             el.style.filter = "blur(8px)";
384             var img = document.createElement('img');
385             img.width = el.width;
386             img.height = el.height;
387             // Shouldn't we also copy the style and maybe even some events?!
388             // img = el.cloneNode(true); // except this doesn't copy the eventListeners etc. Duh.
389             (function(img,container,src) {
390             img.onload = function() {
391             // Put the loaded child in the place of the preloaded data
392             parent.replaceChild(img,container);
393             };
394             var timeout = 1000+Math.random()*3000;
395             // Kick off the loading
396             // The timeout is just for demonstration purposes
397             // window.setTimeout(function() {
398             img.src = src;
399             //}, timeout);
400             }(img,container,fullsrc));
401             } else {
402             // Image has already been loaded (from cache), nothing to do here
403             };
404             };
405              
406             =head1 REPOSITORY
407              
408             The public repository of this module is
409             L.
410              
411             =head1 SUPPORT
412              
413             The public support forum of this module is
414             L.
415              
416             =head1 BUG TRACKER
417              
418             Please report bugs in this module via the RT CPAN bug queue at
419             L
420             or via mail to L.
421              
422             =head1 AUTHOR
423              
424             Max Maischein C
425              
426             =head1 COPYRIGHT (c)
427              
428             Copyright 2015 by Max Maischein C.
429              
430             =head1 LICENSE
431              
432             This module is released under the same terms as Perl itself.
433              
434             =cut
435              
436             1;