Переписать Perl скрипт на PHP

NeoXidizer · June 22, 2012

практикуюсь в портировании standalone приложений в веб сервисы, имеется следующий 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;

за незнанием синтаксиса Perl'а, прошу помочь составить алгоритм, которому следует данный скрипт, если этот скрипт вообще возможно повторить на PHP

Вкратце - скрипт принимает в качестве входных аргументов [путь_к_программе] [входной_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 не интересует

# комментарий
# с упоминанием
# о дальнейшей работе с битами
не понятный мне код

Предпологаю, что поняв смысл всего этого месева из работы с битами и регулярками, можно написать легкий код на PHP (благо есть встроенные функции для вычисления color space, mode, etc

сильно может помочь это http://www.cs.wcupa.edu/~rkline/perl2php/

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

NeoXidizer · June 25, 2012

он он всегда одинаков, поэтому можно не заморачиваться

MiksIr · June 25, 2012

А имеет значение порядок? Лучше вообще не думать о порядке ключей, или их задавать самому. Ориентироваться на дефолтный порядок может быть проблемой http://search.cpan.org/~jhi/perl-5.8.1/pod/perldelta.pod#Hash_Randomisation

NeoXidizer · June 25, 2012

я проверял, порядок не изменяется, да и там далее идет обращение к хешу по ключам, но сами ключи имеют значение, так как на их основе (12, 18 и т.д.) создаются значения. Сделал так:

		$n = array(2 => '', 5 => '', 8 => '', 12 => '', 18 => '');
		array_walk($n, function (&$val, $key, $str) {
					$c = 0;
					return $val = sprintf("$c: 1 %d $str; $c: %d 63 $str;", $key, $key + 1);
				}, $str);

$c в будущем будет назначаться в другом месте. Можно ли сделать лучше? В итоге и в перле и у меня получаются одинаковые массивы

MiksIr · June 25, 2012

Могу сказать, что перловый скрипт тоже написан криво. Хотя бы по тому, как человек юзает sprintf


function try_splits($str, $c) {
  $arr = array_flip(array( 2,5,8,12,18 ));
  foreach ($arr as $key=>&$value) {
     $value = sprintf('%d: 1 %d %s; %d: %d 63 %s;', $c, $key, $str, $c, $key+1, $str);
  }
  unset($value);
  $mode = triesn(2, "$c: 1 63 $str;", array_intersect_key($arr, array_flip(array(2,8,5))));
  if ($mode != $arr[8]) return $mode;
  return triesn(1, $mode, array_intersect_key($arr, array_flip(array(12, 18))));
}

Порядок ключей в массиве вроде как совершенно не нужен - он используется только по прямому индексу

Edited June 25, 2012 by MiksIr

NeoXidizer · June 25, 2012

да, я знаю, что порядок не нужен

про array_flip - спасибо, не додумался

почему такое использование sprintf влияет на производительность? ведь эти переменные не нуждаются в форматировании

зачем в данном случае unset? использование памяти до и после unset не изменяется (проверил)

и в функцию triesn идет лишь 2 параметра - (int)limit и (array)modes

а perl функция обрабатывает все входные параметры таким образом:

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

тобишь $limit идет в $limit, а всё остальное - в массив modes

поведение PHP иное, поэтому я сделал так:

	private function try_splits($str, $c) {
		$n = array_flip(array(2, 5, 8, 12, 18));
		foreach ($n as $key => &$value)
			$value = sprintf('%d: 1 %d %s; %d: %d 63 %s;', $c, $key, $str, $c, $key + 1, $str);

		$modes = array("$c: 1 63 $str;", $n[2], $n[8], $n[5]);
		$mode = $this->triesn(2, $modes);

		if ($mode != $n[8])
			return $mode;
		else {
			$modes = array("$c: 1 63 $str;", $n[12], $n[18]);
			return $this->triesn(1, $modes);
		}
	}

open TRAN, "-|", "./jpegtran", @strip, "-scans", $ftmp, $jtmp or die;

можно пояснить синтаксис?

TRAN - handler

"-|":

Другим интересным подходом к межпроцессному взаимодействию является создание одной многопроцессной программы, которая взаимодействует сама с собой. Функция open() принимает в качестве аргумента "-|" или "|-", при этом происходит интересная вещь: создается дочерний процесс, связанный с дескрипторов файла, который вы открываете. Дочерний процесс выполняет ту же программу, что и родительский.

"./jpegtran" - программа, а остальные аргументы - аргументы идущие в программу, но почему написаны таким образом? почему не так?

open TRAN, "-|", "./jpegtran @strip -scans $ftmp $jtmp" or die;?

P.S. @strip = 2

Edited June 25, 2012 by NeoXidizer

MiksIr · June 25, 2012

> почему такое использование sprintf влияет на производительность

Дело не в производительности. Подстановка переменных в шаблон printf плохо, ибо если внутри переменной будет % символ - будет ошибка. Раз уж printf дает возможность подставлять переменные через плейсхолдеры, так и нада.

>зачем в данном случае unset

Привычка когда цикл с передачей по ссылке

foreach($arr as $key=>&$val) ....;

....

$val = 100500;

И внезапно наш $arr испорчен ибо $val после цикла все еще ссылка на элемент массива. Очень распространенная ошибка.

>и в функцию triesn идет лишь 2 параметра - (int)limit и (array)modes

Ах, да. Ну так тоже намана, даже правильно. Другое решение - можно внутри функции с func_get_args() поиграться. Но в общем, наверно, не нужно.

>./jpegtran" - программа, а остальные аргументы - аргументы идущие в программу, но почему написаны таким образом?

-| это в PHP вроде как аналог popen

А про аргументы... вроде так

$var = "some argument"; - с пробелом тут

open("-|./program $var"); - будет передано шелу на выполнение, у него пробел - разделитель аргументов, т.е. program получит 2(!) аргумента - some и второй - argument.

Если пишем open("-|","./program", $var) - это передает в program один аргумент как строку с пробелом. Аналог этого - open("-|./program '$var'");

Edited June 25, 2012 by MiksIr

NeoXidizer · June 25, 2012

Дело не в производительности. Подстановка переменных в шаблон printf плохо, ибо если внутри переменной будет % символ - будет ошибка. Раз уж printf дает возможность подставлять переменные через плейсхолдеры, так и нада.

я поигрался с бенчмарком, с вашим вариантом выходит быстрее

NeoXidizer · June 28, 2012

В принципе, вот результат. Если есть идеи, как можно оптимизировать, не стесняйтесь!

извиняюсь, что код практически не комментирован, просто опишу функции

// Скрипт ищет оптимальные настройки для программы jpegtran, которая оптимизирует JPEG изображения формата RGB или Grayscale(BW - Black/White)
	private $c;
	private $is_rgb;
	private $modes;
	private $prefix;

	private function jpegscan($i) {
		// определение находится в другом месте
		$this->is_rgb = ($this->cm[$i] == 'RGB' ? 1 : 0);

		if ($this->is_rgb) {
			$this->prefix = '';
			$dc = $this->tries(array('0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;'));
			$this->prefix = '0 1 2: 0 0 0 9;';
		} else {
			$dc = '0: 0 0 0 0;';
			$this->prefix = '0: 0 0 0 9;';
		}

		// Если файл - RGB, то запускает итерацию 2 раза, что запускает внутреннюю итерацию 7 раз.
		// Если файл - BW, то запускает итерацию 1 раз, что запускает внутреннюю итерацию 4 раза.
		$ac = '';
		for ($i = 0; $i < ($this->is_rgb ? 2 : 1); ++$i) {
			$this->c = $i;
			$this->modes = array();
			$ml = '';

			// Если файл - RGB, то повторная итерация запускает внутренню итерацию 3 раза, а не 4
			for ($in = 0, $_ = 0; $in < ($i ? 3 : 4); ++$in, ++$_) {
				$this->modes[] = "$i: 1 8 0 $_; $i: 9 63 0 $_;" . $ml;
				$ml .= "$i: 1 63 " . ($_ + 1) . " $_;";
			}

			$refine = $this->triesn(1, $this->modes);

			preg_match("/.* (0 \d);/", $refine, $matches);
			$ac .= preg_replace("/.* (0 \d);/", "", $refine) . $this->try_splits($matches[1]);
		}
		$this->prefix = '';
		$mode = $this->canonize($dc . $ac);
		$this->_try($mode); // финальная оптимизация
	}

	// см. другие функции. Эта - иные настройки оптимизации
	private function try_splits($str) {
		$n = array_flip(array(2, 5, 8, 12, 18));
		foreach ($n as $key => &$value)
			$value = "$this->c: 1 $key $str; $this->c: " . ($key + 1) . " 63 $str;";

		$mode = $this->triesn(2, array("$this->c: 1 63 $str;", $n[2], $n[8], $n[5]));

		if ($mode != $n[8])
			return $mode;
		else
			return $this->triesn(1, array($mode, $n[12], $n[18]));
	}

	// RGB-Only - запускает triesn и работает, пока не получит свой результат
	private function tries($modes) {
		return $this->triesn(99, $modes);
	}

	// Запускает оптимизацию файла и следит за тем, чтобы оптимизация не увеличивала файл в объеме, возвращает настройки последней оптимизации
	private function triesn($limit, $modes) {
		$overshoot = 0;
		foreach ($modes as $key => $mode) {
			$size = $this->_try($mode);
			if (!isset($bsize) || $size < $bsize) {
				$bsize = $size;
				$overshoot = 0;
				$bmode = $mode;
			} elseif (++$overshoot >= $limit)
				break;
		}
		return $bmode;
	}

	// пробуем оптимизировать изображение, используя приготовленные настройки ($mode), возвращаем получившийся размер файла
	private function _try($mode) {
		$txt = $this->canonize($mode);

		$handle = fopen($this->tmpfilestats, "w+");
		fwrite($handle, $txt);
		fclose($handle);

		pclose(popen($this->executeFiles['jpegtran'] . " -scans $this->tmpfilestats -outfile $this->tmpfilepro $this->tmpfileopt", 'r'));

		clearstatcache(TRUE, $this->tmpfilepro); // Не кешируем результаты запроса
		return filesize($this->tmpfilepro);
	}

	// Функция принимает на себя строку, типа "0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;", очищает, добавляет переводы строк, разбивает на массив и приводит массив к нужному формату, затем этот массив записывается в файл функцией _try
	private function canonize($mode) {
		$txt = $this->prefix . $mode;

		$txt = preg_replace("/\s*;\s*/", ";\n", $txt);
		$txt = preg_replace("/^\s*/", "", $txt);
		$txt = preg_replace("/ +/", " ", $txt);
		$txt = preg_replace("/: (\d+) (\d+)/e", "sprintf(': %2d %2d', $1, $2)", $txt);

		$txt = preg_replace("/^2:.*\n/m", "", $txt);
		$txt = preg_replace("/^1:(.+)\n/m", "1:$1\n2:$1\n", $txt);

		$txt = explode("\n", trim($txt));
		usort($txt, function($a, $ {
					preg_match("/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/", "$a\n$b", $matches) or die('AAA');

					return ($ret = $this->cmp(!$matches[3], !$matches[1])) ?
							$ret : ( ($ret = $this->cmp($matches[4], $matches[2])) ?
									$ret : strcmp($a, $
							);
				}
		);

		return join("\n", $txt);
	}

	// Perl-like cmp
	private function cmp($a, $ {
		return ($a == $ ? 0 : (( $a < $ ? -1 : 1);
	}

	private function _try($mode) {
		$txt = $this->canonize($mode);

		$handle = fopen($this->tmpfilestats, "w+");
		fwrite($handle, $txt);
		fclose($handle);

		pclose(popen("$this->executeFiles['jpegtran'] -scans $this->tmpfilestats -outfile $this->tmpfilepro $this->tmpfileopt", 'r'));

		clearstatcache(TRUE, $this->tmpfilepro);
		return filesize($this->tmpfilepro);
	}

это - самое слабое место скрипта, всмысле производительности. PHP ужасно медленно вызывает внешнюю программу и определяет рамер файла. На данный момент, мой переписанный на PHP скрипт проигрывает Perl скрипту 0.2 секунды на одном и том же файле. Я запускаю скрипт на Windows, но на Linux программа jpegtran (которая запускается через скрипт) сможет выводить результат своей работы не в файл, а в STDOUT (странно, что на Windows не умеет), тогда можно будет просто брать этот STDOut и считать размер файла по нему (как это сделано в Perl скрипте), тогда, думаю, PHP аналог должен работать быстрее. Иначе - я зря потратил кучу времени и лучше немного оптимизирую Perl скрипт >__<

особенно учитывая, что я неплохо научился Perl'у, пока писал этот код....

Edited June 28, 2012 by NeoXidizer

LunatiK · June 28, 2012

Следующий этап переписать jpegtran на php :rofl:

NeoXidizer · June 28, 2012

смысл шутки?

LunatiK · June 28, 2012

смысл шутки?

Такой же, как и переписывать одно на другое, я понимаю если это надо было перенести на другую платформу где работает php и не может perl, те же яйца только вид с боку, единственное что это вам дало так то, что вы попрактиковались в программировании на том и на другом языке, в остальном - пустая трата времени.

Отсюда и получили мой сарказм.

NeoXidizer · June 28, 2012

смысл шутки?
Такой же, как и переписывать одно на другое, я понимаю если это надо было перенести на другую платформу где работает php и не может perl, те же яйца только вид с боку, единственное что это вам дало так то, что вы попрактиковались в программировании на том и на другом языке, в остальном - пустая трата времени.
Отсюда и получили мой сарказм.

Да, насчет практики вы правы. Но...

Моей целью была оптимизация - увеличение скорости выполнения задачи. Меня не устраивало то, что запуск perl скрипта на 15 файлах занимал 12 секунд, я полагал, что переписав скрипт на PHP, и избавившись от вызова perl, я смогу добиться хоть какого-нибудь увеличения производительности, но оказалось наоборот. Зато в процессе этого, по вашему бесмысленного действа, я увидел, каким образом можно оптимизировать сам Perl скрипт, а так же у меня появилось желание попробовать переписать этот алгоритм на C++

MiksIr · June 28, 2012

Ну форк всегда была дорогой операцией не смотря на все copy-on-write.

А какое отношение времени скрипт/jpegtran? Если больше всего jpegtran занимает, то нужна немного другая архитектура и параллелизм.

NeoXidizer · June 29, 2012

Ну форк всегда была дорогой операцией не смотря на все copy-on-write.
А какое отношение времени скрипт/jpegtran? Если больше всего jpegtran занимает, то нужна немного другая архитектура и параллелизм.

в случае PHP скрипта, все время отнимал именно вызов внешней программы, а не сам jpegtran

NeoXidizer · June 29, 2012

и я не представляю, как здесь можно что-то распараллелить, так как количество общих запусков jpegtran зависит от первого/предыдущего запуска jpegtran, не говоря уже о том, что результат нужно отдавать моментально

LunatiK · June 29, 2012

в случае PHP скрипта, все время отнимал именно вызов внешней программы, а не сам jpegtran

Интересно, а как вы это замерили ?

NeoXidizer · June 29, 2012

в случае PHP скрипта, все время отнимал именно вызов внешней программы, а не сам jpegtran

да, с этим ошибся, провел повторное тестирование:

Мой переписанный PHP скрипт на Windows (с записью промежуточных результатов jpegtran в файл, так как в Windows версии невозможен вывод в STDOUT)

vs

Мой переписанный PHP скрипт на виртуальном Debian Linux (с записью промежуточных результатов jpegtran в STDOUT, как в Perl скрипте, что в Windows было невозможным и по моему мнению являлось слабым местом)

vs

Оригинальный Perl скрипт

Код:

$time_start = microtime(true);
for ($is = 0; $is < 100; ++$is)
	$this->jpegscan($i);
	//pclose(popen("perl $perlscript $jpegtran $this->tmpfileopt $this->tmpfilepro", 'r'));
$time_end = microtime(true);
$time = $time_end - $time_start;
echo "Done in $time seconds\n";

PHP Windows: Done in 73.553564071655 seconds

PHP Linux: Done in 36.657097005844 seconds

Perl: Done in 36.591314077377 seconds

в конечном результате, я хоть и не смог добиться увеличения производительности, но я смог переписать Perl скрипт на PHP, и результаты отличаются лишь погрешностью, а так же я познакомился с Perl'ом

Sign In

Переписать Perl скрипт на PHP

Question

Link to comment

Share on other sites

42 answers to this question

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Обсуждения

Important Information