Comparar texto

Encuentra la diferencia entre dos archivos de texto

Real-time diff

Unified diff

Collapse lines

Highlight change

Syntax highlighting

Herramientas

Diffchecker Desktop The most secure way to run Diffchecker. Get the Diffchecker Desktop app: your diffs never leave your computer!Get Desktop

Untitled diff

Created 10 years agoDiff never expires

Lines
Total
Removed

Words
Total
Removed

To continue using this feature, upgrade to Diffchecker Pro View Pricing

0 lines

Lines
Total
Added

Words
Total
Added

To continue using this feature, upgrade to Diffchecker Pro View Pricing

Diffs guardadas

Texto original

Abrir archivo

Texto modificado

Abrir archivo

#!/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;
}