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