![]() |
Внимание, важное сообщение: Дорогие Друзья!
В ноябре далекого 2001 года мы решили создать сайт и форум, которые смогут помочь как начинающим, так и продвинутым пользователям разобраться в операционных системах. В 2004-2006г наш проект был одним из самых крупных ИТ ресурсов в рунете, на пике нас посещало более 300 000 человек в день! Наша документация по службам Windows и автоматической установке помогла огромному количеству пользователей и сисадминов. Мы с уверенностью можем сказать, что внесли большой вклад в развитие ИТ сообщества рунета. Но... время меняются, приоритеты тоже. И, к сожалению, пришло время сказать До встречи! После долгих дискуссий было принято решение закрыть наш проект. 1 августа форум переводится в режим Только чтение, а в начале сентября мы переведем рубильник в положение Выключен Огромное спасибо за эти 24 года, это было незабываемое приключение. Сказать спасибо и поделиться своей историей можно в данной теме. С уважением, ваш призрачный админ, BigMac... |
|
Компьютерный форум OSzone.net » Компьютеры + Интернет » Вебмастеру » Переписать Perl скрипт на PHP |
|
Переписать Perl скрипт на PHP
|
Новый участник Сообщения: 14 |
Нужна помощь, достаточно будет объяснить алгоритм работы 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; Лишний код, типа перенаправление потоков 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 |
![]() |
Участник сейчас на форуме |
![]() |
Участник вне форума |
![]() |
Автор темы |
![]() |
Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
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 |
|