Compare text

Find the difference between two text files

Real-time diff

Unified diff

Collapse lines

Highlight change

Syntax highlighting

Tools

Untitled diff

Created 9 years agoDiff never expires

0 removals

0 lines

216 additions

216 lines

#!/usr/bin/perl -ws

# jpegrescan by Loren Merritt

# This code is public domain.

use File::Slurp;

use File::Temp qw/ tempfile /;

require threads if $t;

@ARGV==2 or die "usage: jpegrescan in.jpg out.jpg

tries various progressive scan orders

switches:

-s strip from all extra markers (`jpegtran -copy none` otherwise `jpegtran -copy all`)

-i allow optimizations that may be incompatible with some software (implies -s)

-t use multiple threads (usually 3.) Faster, but not 3x faster.

-v verbose output

-q supress all output

-a use arithmetic coding (unsupported by most software)

$fin = $ARGV[0];

$fout = $ARGV[1];

(undef, $ftmp) = tempfile(SUFFIX => ".scan");

$jtmp = $fout;

$verbose = $v;

$quiet = $q;

if($t) {

$triesn = \&triesnthreads;

} else {

$triesn = \&triesn;

}

$incompatible = $i;

$dostrip = $s || $i;

@strip = $dostrip ? ("-copy","none") : ("-copy","all");

@arith = $a ? ("-arithmetic") : ();

undef $_ for $v,$q,$t,$s,$i,$a;

undef $/;

$|=1;

# convert the input to baseline, just to make all the other conversions faster

# FIXME there's still a bunch of redundant computation in separate calls to jpegtran

open $OLDERR, ">&", STDERR;

open STDERR, ">", $ftmp;

open TRAN, "-|", "jpegtran", "-v", @strip, "-optimize", $fin or die;

$data = <TRAN>;

close TRAN;

open STDERR, ">&", $OLDERR;

# Strictly speaking, jfifremove does not generate a compliant JPEG file.

# However, this is our temp file. It will always be run by jpegtran again.

# So this gets rid of all existing JFIF segments.

# And jpegtran will insert a minimal (18-byte) JFIF segment.

# (Which -o will remove again if requested!)

$data = jfifremove($data) if($dostrip);

write_file($jtmp, $data);

undef $data;

$type = read_file($ftmp);

$type =~ /components=(\d+)/ or die;

$rgb = $1==3 ? 1 : $1==1 ? 0 : die "not RGB nor gray\n";

# Remove JFIF sections, written by Ken Brazier.

# Based on http://lyncd.com/files/imgopt/jfifremove.c

# Based on http://archives.devshed.com/forums/compression-130/question-about-using-jpegtran-for-lossless-compression-of-jpegs-2013044.html

sub jfifremove {

my $file = $_[0];

while($file =~ /^\xff\xd8\xff\xe0(.)(.)/) {

# Next 2 bytes after APP0 are length of JFIF segment *excluding* APP0, but including themselves.

my $len = ord($1)*256+ord($2);

#print "Deleting $len bytes.\n";

unless($file =~ s/^(\xff\xd8)\xff\xe0.{$len}/$1/s) {

warn "Problem with JFIF segment of length $len" unless $quiet;

return $file;

}

!$quiet && print $verbose ? "Removed ".(length($_[0])-length($file)-($incompatible?0:18))." jfif bytes.\n".length($file)."\n\n" : ".";

return $file;

}

# FIXME optimize order for either progressive transfer or decoding speed

sub canonize {

my $txt = $prefix.$suffix.shift;

$txt =~ s/\s*;\s*/;\n/g;

$txt =~ s/^\s*//;

$txt =~ s/ +/ /g;

$txt =~ s/: (\d+) (\d+)/sprintf ": %2d %2d", $1, $2/ge;

# treat u and v identically. I shouldn't need to do this, but with jpegtran overhead it saves 9% speed. cost: .008% bitrate.

$txt =~ s/^2:.*\n//gm;

$txt =~ s/^1:(.+)\n/1:$1\n2:$1\n/gm;

# dc before ac, coarse before fine

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;

return join "\n", @txt;

}

# Arguments:

# - Shift string

sub try {

my $txt = canonize(shift);

return $memo{$txt} if $memo{$txt};

my $lftmp = $ftmp;

$lftmp .= shift if($#_ == 0);

write_file($lftmp, $txt);

open TRAN, "-|", "jpegtran", @arith, @strip, "-scans", $lftmp, $jtmp or die;

$data = <TRAN>;

close TRAN;

my $s = length $data;

$s or die;

!$quiet && print $verbose ? "$txt\n$s\n\n" : ".";

if($ftmp eq $lftmp) { # Only if this isn't in a thread.

$memo{$txt} = $s;

return $s;

} else {

return ($s, $txt);

}

$maxtries = -1;

sub triesnthreads {

my($bmode, $bsize);

my ($limit, @modes) = @_;

my @modethread;

$limit = $#modes;# if($#modes < $limit);

for(my $i=0; $i <= $limit; $i++) {

push @modethread, threads->create(\&try, $modes[$i], $i);

}

$maxtries = $#modes if($#modes > $maxtries);

for(my $i=0; $i <= $limit; $i++) {

my ($s,$cmode) = $modethread[$i]->join();

# Do this outside the thread, to make sure it's saved.

$memo{$cmode} = $s if(defined($cmode));

if(!$bsize || $s < $bsize) {

$bsize = $s;

$bmode = $modes[$i];

}

return $bmode;

}

sub triesn {

my($bmode, $bsize);

my ($limit, @modes) = @_;

my $overshoot = 0;

for(@modes) {

my $s = try($_);

if(!$bsize || $s < $bsize) {

$bsize = $s;

$bmode = $_;

$overshoot = 0;

} elsif(++$overshoot >= $limit) {

last;

}

return $bmode;

}

sub tries { &$triesn(99, @_); }

$prefix = "";

$suffix = "";

if($rgb) {

# 012 helps very little

# 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

# dc refinement passes never help

my @tries = ("0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;");

# two scans expose a bug in Opera <= 11.61

unshift(@tries, "0: 0 0 0 0; 1 2: 0 0 0 0;") if $incompatible;

$dc = tries(@tries);

# jpegtran won't let me omit dc entirely, but I can at least quantize it away to make the rest of the tests faster.

$prefix = "0 1 2: 0 0 0 9;";

} else {

$dc = "0: 0 0 0 0;";

$prefix = "0: 0 0 0 9;";

}

# luma can make use of up to 3 refinement passes.

# chroma can make use of up to 2 refinement passes.

# refinement passes have some chance of being split (luma: 4%,4%,4%. chroma: 20%,8%) but the total bit gain is negligible.

# msb pass should almost always be split (luma: 87%, chroma: 81%).

# I have no theoretical reason for this list of split positions, they're just the most common in practice.

# splitting into 3 ections is often slightly better, but the total number of bits saved is negligible.

# FIXME: penalize lots of refinement passes because it's slower to decode. if so, then also force overwrite if bigger than the input.

sub try_splits {

my $str = shift;

my %n = map {$_ => sprintf "$c: 1 %d $str; $c: %d 63 $str;", $_, $_+1} 2,5,8,12,18;

my $mode = &$triesn(3, "$c: 1 63 $str;", @n{2,8,5});

return $mode if $mode ne $n{8};

return &$triesn(2, $mode, @n{12,18});

}

foreach $c (0..$rgb) {

my @modes;

my $ml = "";

for(0..($c?2:3)) {

push @modes, "$c: 1 8 0 $_; $c: 9 63 0 $_;".$ml;

$ml .= sprintf("$c: 1 63 %d %d;", $_+1, $_);

}

my $refine = &$triesn(1, @modes);

$refine =~ s/.* (0 \d);//;

$ac .= $refine . try_splits($1);

}

$prefix = "";

undef %memo;

$mode = canonize($dc.$ac);

try($mode);

$data = jfifremove($data) if($incompatible);

$size = length $data;

!$quiet && print "\n$mode\n$size\n";

$old_size = -s $fin;

!$quiet && printf "%+.2f%%\n", ($size/$old_size-1)*100;

if($size <= $old_size) {

write_file($fout, $data);

}

unlink $ftmp;

for(my $i=0; $i <= $maxtries; $i++) {

unlink $ftmp.$i;

}

Saved diffs

Original text

Open file

Changed text

Open file

#!/usr/bin/perl -ws
# jpegrescan by Loren Merritt
# This code is public domain.

use File::Slurp;
use File::Temp qw/ tempfile /;
require threads if $t;

@ARGV==2 or die "usage: jpegrescan in.jpg out.jpg
tries various progressive scan orders
switches:
  -s strip from all extra markers (`jpegtran -copy none` otherwise `jpegtran -copy all`)
  -i allow optimizations that may be incompatible with some software (implies -s)
  -t use multiple threads (usually 3.)  Faster, but not 3x faster.
  -v verbose output
  -q supress all output
  -a use arithmetic coding (unsupported by most software)
";
$fin = $ARGV[0];
$fout = $ARGV[1];
(undef, $ftmp) = tempfile(SUFFIX => ".scan");
$jtmp = $fout;
$verbose = $v;
$quiet = $q;
if($t) {
  $triesn = \&triesnthreads;
} else {
  $triesn = \&triesn;
}
$incompatible = $i;
$dostrip = $s || $i;
@strip = $dostrip ? ("-copy","none") : ("-copy","all");
@arith = $a ? ("-arithmetic") : ();
undef $_ for $v,$q,$t,$s,$i,$a;
undef $/;
$|=1;

# convert the input to baseline, just to make all the other conversions faster
# FIXME there's still a bunch of redundant computation in separate calls to jpegtran
open $OLDERR, ">&", STDERR;
open STDERR, ">", $ftmp;
open TRAN, "-|", "jpegtran", "-v", @strip, "-optimize", $fin or die;
$data = <TRAN>;
close TRAN;
open STDERR, ">&", $OLDERR;
# Strictly speaking, jfifremove does not generate a compliant JPEG file.
# However, this is our temp file.  It will always be run by jpegtran again.
# So this gets rid of all existing JFIF segments.
# And jpegtran will insert a minimal (18-byte) JFIF segment.
# (Which -o will remove again if requested!)
$data = jfifremove($data) if($dostrip);
write_file($jtmp, $data);
undef $data;

$type = read_file($ftmp);
$type =~ /components=(\d+)/ or die;
$rgb = $1==3 ? 1 : $1==1 ? 0 : die "not RGB nor gray\n";

# Remove JFIF sections, written by Ken Brazier.
# Based on http://lyncd.com/files/imgopt/jfifremove.c
# Based on http://archives.devshed.com/forums/compression-130/question-about-using-jpegtran-for-lossless-compression-of-jpegs-2013044.html
sub jfifremove {
  my $file = $_[0];
  while($file =~ /^\xff\xd8\xff\xe0(.)(.)/) {
    # Next 2 bytes after APP0 are length of JFIF segment *excluding* APP0, but including themselves.
    my $len = ord($1)*256+ord($2);
    #print "Deleting $len bytes.\n";
    unless($file =~ s/^(\xff\xd8)\xff\xe0.{$len}/$1/s) {
      warn "Problem with JFIF segment of length $len" unless $quiet;
      return $file;
    }
  }
  !$quiet && print $verbose ? "Removed ".(length($_[0])-length($file)-($incompatible?0:18))." jfif bytes.\n".length($file)."\n\n" : ".";
  return $file;
}

# FIXME optimize order for either progressive transfer or decoding speed
sub canonize {
    my $txt = $prefix.$suffix.shift;
    $txt =~ s/\s*;\s*/;\n/g;
    $txt =~ s/^\s*//;
    $txt =~ s/ +/ /g;
    $txt =~ s/: (\d+) (\d+)/sprintf ": %2d %2d", $1, $2/ge;
    # treat u and v identically. I shouldn't need to do this, but with jpegtran overhead it saves 9% speed. cost: .008% bitrate.
    $txt =~ s/^2:.*\n//gm;
    $txt =~ s/^1:(.+)\n/1:$1\n2:$1\n/gm;
    # dc before ac, coarse before fine
    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;
    return join "\n", @txt;
}

# Arguments:
# - Shift string
sub try {
    my $txt = canonize(shift);
    return $memo{$txt} if $memo{$txt};
    my $lftmp = $ftmp;
    $lftmp .= shift if($#_ == 0);
    write_file($lftmp, $txt);
    open TRAN, "-|", "jpegtran", @arith, @strip, "-scans", $lftmp, $jtmp or die;
    $data = <TRAN>;
    close TRAN;
    my $s = length $data;
    $s or die;
    !$quiet && print $verbose ? "$txt\n$s\n\n" : ".";
    if($ftmp eq $lftmp) { # Only if this isn't in a thread.
      $memo{$txt} = $s;
      return $s;
    } else {
      return ($s, $txt);
    }
}

$maxtries = -1;

sub triesnthreads {
  my($bmode, $bsize);
  my ($limit, @modes) = @_;
  my @modethread;
  $limit = $#modes;# if($#modes < $limit);
  for(my $i=0; $i <= $limit; $i++) {
    push @modethread, threads->create(\&try, $modes[$i], $i);
  }
  $maxtries = $#modes if($#modes > $maxtries);
  for(my $i=0; $i <= $limit; $i++) {
    my ($s,$cmode) = $modethread[$i]->join();
    # Do this outside the thread, to make sure it's saved.
    $memo{$cmode} = $s if(defined($cmode));
    if(!$bsize || $s < $bsize) {
      $bsize = $s;
      $bmode = $modes[$i];
    }
  }
  return $bmode;
}

sub triesn {
    my($bmode, $bsize);
    my ($limit, @modes) = @_;
    my $overshoot = 0;
    for(@modes) {
        my $s = try($_);
        if(!$bsize || $s < $bsize) {
            $bsize = $s;
            $bmode = $_;
            $overshoot = 0;
        } elsif(++$overshoot >= $limit) {
            last;
        }
    }
    return $bmode;
}

sub tries { &$triesn(99, @_); }

$prefix = "";
$suffix = "";

if($rgb) {
    # 012 helps very little
    # 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
    # dc refinement passes never help
    my @tries = ("0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;");
    # two scans expose a bug in Opera <= 11.61
    unshift(@tries, "0: 0 0 0 0; 1 2: 0 0 0 0;") if $incompatible;
    $dc = tries(@tries);
    # jpegtran won't let me omit dc entirely, but I can at least quantize it away to make the rest of the tests faster.
    $prefix = "0 1 2: 0 0 0 9;";
} else {
    $dc = "0: 0 0 0 0;";
    $prefix = "0: 0 0 0 9;";
}

# luma can make use of up to 3 refinement passes.
# chroma can make use of up to 2 refinement passes.
# refinement passes have some chance of being split (luma: 4%,4%,4%. chroma: 20%,8%) but the total bit gain is negligible.
# msb pass should almost always be split (luma: 87%, chroma: 81%).
# I have no theoretical reason for this list of split positions, they're just the most common in practice.
# splitting into 3 ections is often slightly better, but the total number of bits saved is negligible.
# FIXME: penalize lots of refinement passes because it's slower to decode. if so, then also force overwrite if bigger than the input.
sub try_splits {
    my $str = shift;
    my %n = map {$_ => sprintf "$c: 1 %d $str; $c: %d 63 $str;", $_, $_+1} 2,5,8,12,18;
    my $mode = &$triesn(3, "$c: 1 63 $str;", @n{2,8,5});
    return $mode if $mode ne $n{8};
    return &$triesn(2, $mode, @n{12,18});
}

foreach $c (0..$rgb) {
    my @modes;
    my $ml = "";
    for(0..($c?2:3)) {
        push @modes, "$c: 1 8 0 $_; $c: 9 63 0 $_;".$ml;
        $ml .= sprintf("$c: 1 63 %d %d;", $_+1, $_);
    }
    my $refine = &$triesn(1, @modes);
    $refine =~ s/.* (0 \d);//;
    $ac .= $refine . try_splits($1);
}

$prefix = "";
undef %memo;
$mode = canonize($dc.$ac);
try($mode);
$data = jfifremove($data) if($incompatible);
$size = length $data;
!$quiet && print "\n$mode\n$size\n";
$old_size = -s $fin;
!$quiet && printf "%+.2f%%\n", ($size/$old_size-1)*100;
if($size <= $old_size) {
    write_file($fout, $data);
}
unlink $ftmp;
for(my $i=0; $i <= $maxtries; $i++) {
  unlink $ftmp.$i;
}