Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Компьютеры + Интернет » Вебмастеру » Переписать Perl скрипт на PHP

Ответить
Настройки темы
Переписать Perl скрипт на PHP

Новый участник


Сообщения: 14
Благодарности: 1

Профиль | Отправить PM | Цитировать


Нужна помощь, достаточно будет объяснить алгоритм работы perl скрипта
Код: Выделить весь код
#!/usr/bin/perl -ws
# jpegrescan by Loren Merritt
# Last updated: 2008-11-29 / 2011-11-01
# This code is public domain.

use File::Slurp;
@ARGV==2 or die "usage: jpegrescan in.jpg out.jpg\ntries various progressive scan orders\n";
$fin = $ARGV[0];
$fout = $ARGV[1];
$ftmp = "$fout-$$.scan";
$jtmp = $fout;
$verbose = $v;
$quiet = $q;
undef $_ for $v,$q;
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", "-optimize", $fin or die;
write_file($jtmp, <TRAN>);
close TRAN;
open STDERR, ">&", $OLDERR;

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

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

sub try {
    my $txt = canonize(shift);
    return $memo{$txt} if $memo{$txt};
    write_file($ftmp, $txt);
    open TRAN, "-|", "./jpegtran", "-scans", $ftmp, $jtmp or die;
    $data = <TRAN>;
    close TRAN;
    my $s = length $data;
    $s or die;
    $memo{$txt} = $s;
    !$quiet && print $verbose ? "$txt\n$s\n\n" : ".";
    return $s;
}

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
    $dc = tries("0: 0 0 0 0; 1 2: 0 0 0 0;",
                "0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;");
    # 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(2, "$c: 1 63 $str;", @n{2,8,5});
    return $mode if $mode ne $n{8};
    return triesn(1, $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);
$size = $memo{$mode};
!$quiet && print "\n$mode\n$size\n";
$old_size = -s $fin;
if($size < $old_size) {
        write_file($fout, $data);
}
unlink $ftmp;
Вкратце - скрипт принимает в качестве входных аргументов [путь_к_программе] [входной_jpeg_файл] [выходной_файл] и ищет оптимальный способ оптимизации (параметров для запуска программы из аргумента[0]

Лишний код, типа перенаправление потоков STDERR (и других) можно пропускать
либо помочь сделать так, чтобы вывод не блокировался, и был виден весь прогресс работы

Мой набросок:
Код: Выделить весь код
Объявление переменных

#Комментарий - конвертирование файла в baseline, чтобы ускорить все остальные конвертации
jpegtran -v -optimize $file

объявление $type, не знаю, что это, скорее всего определения формата - baseline или progressive
объявление $rgb - цветового пространства (color space), проверяет, является ли формат файла RGB, либо BW, CMYK не пропускает

#FIXME
sub canonize, месиво из регулярок(help)
sub try, запуск jpegtran с параметром -scans file
sub triesn, не понять
sub tries { triesn(99, @_); } - ?

if($rgb) {
какая-то магия, очевидно запуск функции tries с заданными параметрами
$dc = tries("0: 0 0 0 0; 1 2: 0 0 0 0;",
                "0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;");
} else не интересует

# комментарий
# с упоминанием
# о дальнейшей работе с битами
не понятный мне код
либо, если кто-то найдет онлайн трянслятор, буду благодарен, даже если будет на половину не рабочим
либо объяснит алгоритм работы

Отправлено: 16:15, 22-06-2012

 


Компьютерный форум OSzone.net » Компьютеры + Интернет » Вебмастеру » Переписать Perl скрипт на PHP

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
CMD/BAT - [решено] Нужно переписать скрипт - сделать скрытые папки видимыми RomanLis Скриптовые языки администрирования Windows 11 02-06-2012 17:02
Разное - Скрипт на Perl Termo27 Программирование и базы данных 2 20-05-2010 06:24
Помогите переписать скрипт Hawk37 AutoIt 1 28-02-2010 02:14
Не работает скрипт на Perl Rudy Вебмастеру 1 18-06-2004 19:22
VBS/WSH/JS - Как переписать скрипт на VSCript или на Jscript??? zona Программирование и базы данных 1 04-01-2003 22:38




 
Переход