├── .gitignore ├── DEPENDS ├── LICENSE ├── README.md └── jpegrescan /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | -------------------------------------------------------------------------------- /DEPENDS: -------------------------------------------------------------------------------- 1 | Project: jpegrescan-perl 2 | Homepage: https://github.com/kud/jpegrescan 3 | Depends: perl, libfile-slurp-perl, libjpeg-progs 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Public Domain Mark 1.0 2 | No Copyright 3 | 4 | This work has been identified as being free of known restrictions under copyright law, including all related and neighboring rights. 5 | 6 | 7 | You can copy, modify, distribute and perform the work, even for commercial purposes, all without asking permission. See Other Information below. 8 | 9 | Other Information 10 | 11 | The work may not be free of known copyright restrictions in all jurisdictions. 12 | Persons may have other rights in or related to the work, such as patent or trademark rights, and others may have rights in how the work is used, such as publicity or privacy rights. 13 | In some jurisdictions moral rights of the author may persist beyond the term of copyright. These rights may include the right to be identified as the author and the right to object to derogatory treatments. 14 | Unless expressly stated otherwise, the person who identified the work makes no warranties about the work, and disclaims liability for all uses of the work, to the fullest extent permitted by applicable law. 15 | When using or citing the work, you should not imply endorsement by the author or the person who identified the work. 16 | 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # JPEGrescan: losslessly shrink any JPEG file 2 | JPEGrescan is a perl script that uses jpeg tools to optimise jpeg compression by micro-managing some of the compression math based on research into some of the most common parameters. 3 | 4 | NB: [MozJPEG](https://github.com/mozilla/mozjpeg) has the same optimisation built-in and is faster, so we recommend using MozJPEG when possible. 5 | 6 | ## Usage 7 | ```$ jpegrescan in.jpg out.jpg``` 8 | 9 | ### Arguments 10 | * -s: Removes all Exif data and now all JFIF data as well. A basic 18-byte JFIF segment is added in its place. 11 | * -i: Allows optimisations that may be "incompatible" with some software. Currently this means removing *all* JFIF data (saving 18 bytes) and allowing an encoding not supported by Opera before version 11.61. 12 | * -t: Turns on multithreaded operation. Usually, uses up to 4 threads. Faster, but not four times faster than without _-t_. So try _xargs -n1 -P_ to shrink a large number of jpegs at the same time. 13 | * -a: Turns on arithmetic coding. Note this is unsupported by most software. 14 | * -v: Verbose output. 15 | * -q: Suppress all output. 16 | 17 | ## Package Availability 18 | JPEGrescan is known to be packaged in the following distributions: 19 | * Arch's User Repository 20 | * NixOS 21 | 22 | ## Issues 23 | * No out.jpg. Install the following: 24 | * Fedora: ```yum -y install perl-File-Slurp libjpeg-turbo-utils``` 25 | * Debian: ```aptitude install -y libfile-slurp-perl libjpeg-turbo-progs``` 26 | 27 | ## Thanks 28 | First, thanks to **Loren Merritt** who created this script originally. Also, thanks to the people on [devshed](https://www.devshed.com/) and [lyncd](https://lyncd.com/) - whose names seem to be lost to the sands of time - who came up with the jfifremove idea and the basic C code. 29 | -------------------------------------------------------------------------------- /jpegrescan: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -ws 2 | # jpegrescan by Loren Merritt 3 | # This code is public domain. 4 | 5 | use File::Slurp; 6 | use File::Temp qw/ tempfile /; 7 | require threads if $t; 8 | 9 | @ARGV==2 or die "usage: jpegrescan in.jpg out.jpg 10 | tries various progressive scan orders 11 | switches: 12 | -s Strip from all extra markers (`jpegtran -copy none` otherwise `jpegtran -copy all`). 13 | -i Allow optimizations that may be incompatible with some software (implies -s). 14 | -t Use multiple threads (usually 3). Faster, but not 3x faster. 15 | -a Use arithmetic coding. Unsupported by most software. 16 | -v Verbose output. 17 | -q Suppress all output. 18 | "; 19 | $fin = $ARGV[0]; 20 | $fout = $ARGV[1]; 21 | (undef, $ftmp) = tempfile(SUFFIX => ".scan"); 22 | $jtmp = $fout; 23 | $verbose = $v; 24 | $quiet = $q; 25 | if($t) { 26 | $triesn = \&triesnthreads; 27 | } else { 28 | $triesn = \&triesn; 29 | } 30 | $incompatible = $i; 31 | $dostrip = $s || $i; 32 | @strip = $dostrip ? ("-copy","none") : ("-copy","all"); 33 | @arith = $a ? ("-arithmetic") : (); 34 | undef $_ for $v,$q,$t,$s,$i,$a; 35 | undef $/; 36 | $|=1; 37 | 38 | # convert the input to baseline, just to make all the other conversions faster 39 | # FIXME there's still a bunch of redundant computation in separate calls to jpegtran 40 | open $OLDERR, ">&", STDERR; 41 | open STDERR, ">", $ftmp; 42 | open TRAN, "-|", "jpegtran", "-v", @strip, "-optimize", $fin or die; 43 | $data = ; 44 | close TRAN; 45 | open STDERR, ">&", $OLDERR; 46 | # Strictly speaking, jfifremove does not generate a compliant JPEG file. 47 | # However, this is our temp file. It will always be run by jpegtran again. 48 | # So this gets rid of all existing JFIF segments. 49 | # And jpegtran will insert a minimal (18-byte) JFIF segment. 50 | # (Which -o will remove again if requested!) 51 | $data = jfifremove($data) if($dostrip); 52 | write_file($jtmp, $data); 53 | undef $data; 54 | 55 | $type = read_file($ftmp); 56 | $type =~ /components=(\d+)/ or die; 57 | $rgb = $1==3 ? 1 : $1==1 ? 0 : die "not RGB nor gray\n"; 58 | 59 | # Remove JFIF sections, written by Ken Brazier. 60 | # Based on http://lyncd.com/files/imgopt/jfifremove.c 61 | # Based on http://archives.devshed.com/forums/compression-130/question-about-using-jpegtran-for-lossless-compression-of-jpegs-2013044.html 62 | sub jfifremove { 63 | my $file = $_[0]; 64 | while($file =~ /^\xff\xd8\xff\xe0(.)(.)/s) { 65 | # Next 2 bytes after APP0 are length of JFIF segment *excluding* APP0, but including themselves. 66 | my $len = ord($1)*256+ord($2); 67 | #print "Deleting $len bytes.\n"; 68 | unless($file =~ s/^(\xff\xd8)\xff\xe0.{$len}/$1/s) { 69 | warn "Problem with JFIF segment of length $len" unless $quiet; 70 | return $file; 71 | } 72 | } 73 | !$quiet && print $verbose ? "Removed ".(length($_[0])-length($file)-($incompatible?0:18))." jfif bytes.\n".length($file)."\n\n" : "."; 74 | return $file; 75 | } 76 | 77 | # FIXME optimize order for either progressive transfer or decoding speed 78 | sub canonize { 79 | my $txt = $prefix.$suffix.shift; 80 | $txt =~ s/\s*;\s*/;\n/g; 81 | $txt =~ s/^\s*//; 82 | $txt =~ s/ +/ /g; 83 | $txt =~ s/: (\d+) (\d+)/sprintf ": %2d %2d", $1, $2/ge; 84 | # treat u and v identically. I shouldn't need to do this, but with jpegtran overhead it saves 9% speed. cost: .008% bitrate. 85 | $txt =~ s/^2:.*\n//gm; 86 | $txt =~ s/^1:(.+)\n/1:$1\n2:$1\n/gm; 87 | # dc before ac, coarse before fine 88 | my @txt = sort {"$a\n$b" =~ /: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/ or die; !$3 <=> !$1 or $4 <=> $2 or $a cmp $b;} split /\n/, $txt; 89 | return join "\n", @txt; 90 | } 91 | 92 | # Arguments: 93 | # - Shift string 94 | sub try { 95 | my $txt = canonize(shift); 96 | return $memo{$txt} if $memo{$txt}; 97 | my $lftmp = $ftmp; 98 | $lftmp .= shift if($#_ == 0); 99 | write_file($lftmp, $txt); 100 | open TRAN, "-|", "jpegtran", @arith, @strip, "-scans", $lftmp, $jtmp or die; 101 | $data = ; 102 | close TRAN; 103 | my $s = length $data; 104 | $s or die; 105 | !$quiet && print $verbose ? "$txt\n$s\n\n" : "."; 106 | if($ftmp eq $lftmp) { # Only if this isn't in a thread. 107 | $memo{$txt} = $s; 108 | return $s; 109 | } else { 110 | return ($s, $txt); 111 | } 112 | } 113 | 114 | $maxtries = -1; 115 | 116 | sub triesnthreads { 117 | my($bmode, $bsize); 118 | my ($limit, @modes) = @_; 119 | my @modethread; 120 | $limit = $#modes;# if($#modes < $limit); 121 | for(my $i=0; $i <= $limit; $i++) { 122 | push @modethread, threads->create(\&try, $modes[$i], $i); 123 | } 124 | $maxtries = $#modes if($#modes > $maxtries); 125 | for(my $i=0; $i <= $limit; $i++) { 126 | my ($s,$cmode) = $modethread[$i]->join(); 127 | # Do this outside the thread, to make sure it's saved. 128 | $memo{$cmode} = $s if(defined($cmode)); 129 | if(!$bsize || $s < $bsize) { 130 | $bsize = $s; 131 | $bmode = $modes[$i]; 132 | } 133 | } 134 | return $bmode; 135 | } 136 | 137 | sub triesn { 138 | my($bmode, $bsize); 139 | my ($limit, @modes) = @_; 140 | my $overshoot = 0; 141 | for(@modes) { 142 | my $s = try($_); 143 | if(!$bsize || $s < $bsize) { 144 | $bsize = $s; 145 | $bmode = $_; 146 | $overshoot = 0; 147 | } elsif(++$overshoot >= $limit) { 148 | last; 149 | } 150 | } 151 | return $bmode; 152 | } 153 | 154 | sub tries { &$triesn(99, @_); } 155 | 156 | $prefix = ""; 157 | $suffix = ""; 158 | 159 | if($rgb) { 160 | # 012 helps very little 161 | # 0/12 and 0/1/2 are pretty evenly matched in frequency, but 0/12 wins in total size if every image had to use the same mode 162 | # dc refinement passes never help 163 | my @tries = ("0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;"); 164 | # two scans expose a bug in Opera <= 11.61 165 | unshift(@tries, "0: 0 0 0 0; 1 2: 0 0 0 0;") if $incompatible; 166 | $dc = tries(@tries); 167 | # jpegtran won't let me omit dc entirely, but I can at least quantize it away to make the rest of the tests faster. 168 | $prefix = "0 1 2: 0 0 0 9;"; 169 | } else { 170 | $dc = "0: 0 0 0 0;"; 171 | $prefix = "0: 0 0 0 9;"; 172 | } 173 | 174 | # luma can make use of up to 3 refinement passes. 175 | # chroma can make use of up to 2 refinement passes. 176 | # refinement passes have some chance of being split (luma: 4%,4%,4%. chroma: 20%,8%) but the total bit gain is negligible. 177 | # msb pass should almost always be split (luma: 87%, chroma: 81%). 178 | # I have no theoretical reason for this list of split positions, they're just the most common in practice. 179 | # splitting into 3 sections is often slightly better, but the total number of bits saved is negligible. 180 | # FIXME: penalize lots of refinement passes because it's slower to decode. if so, then also force overwrite if bigger than the input. 181 | sub try_splits { 182 | my $str = shift; 183 | my %n = map {$_ => sprintf "$c: 1 %d $str; $c: %d 63 $str;", $_, $_+1} 2,5,8,12,18; 184 | my $mode = &$triesn(3, "$c: 1 63 $str;", @n{2,8,5}); 185 | return $mode if $mode ne $n{8}; 186 | return &$triesn(2, $mode, @n{12,18}); 187 | } 188 | 189 | foreach $c (0..$rgb) { 190 | my @modes; 191 | my $ml = ""; 192 | for(0..($c?2:3)) { 193 | push @modes, "$c: 1 8 0 $_; $c: 9 63 0 $_;".$ml; 194 | $ml .= sprintf("$c: 1 63 %d %d;", $_+1, $_); 195 | } 196 | my $refine = &$triesn(1, @modes); 197 | $refine =~ s/.* (0 \d);//; 198 | $ac .= $refine . try_splits($1); 199 | } 200 | 201 | $prefix = ""; 202 | undef %memo; 203 | $mode = canonize($dc.$ac); 204 | try($mode); 205 | $data = jfifremove($data) if($incompatible); 206 | $size = length $data; 207 | !$quiet && print "\n$mode\n$size\n"; 208 | $old_size = -s $fin; 209 | !$quiet && printf "%+.2f%%\n", ($size/$old_size-1)*100; 210 | if($size <= $old_size) { 211 | write_file($fout, $data); 212 | } 213 | unlink $ftmp; 214 | for(my $i=0; $i <= $maxtries; $i++) { 215 | unlink $ftmp.$i; 216 | } 217 | --------------------------------------------------------------------------------