Говнокод #4506 — Perl — Говнокод.ру

Perl / Говнокод #4506

−126
1. 01
2. 02
3. 03
4. 04
5. 05
6. 06
7. 07
8. 08
9. 09
10. 10
11. 11
12. 12
13. 13
14. 14
15. 15
16. 16
17. 17
18. 18
19. 19
20. 20
21. 21
22. 22
23. 23
24. 24
25. 25
26. 26
27. 27
28. 28
29. 29
30. 30
31. 31
32. 32
33. 33
34. 34
35. 35
36. 36
37. 37
38. 38
39. 39
40. 40
41. 41
42. 42
43. 43
44. 44
45. 45
46. 46
47. 47
48. 48
49. 49
50. 50
51. 51
52. 52
53. 53
54. 54
55. 55
56. 56
57. 57
58. 58
59. 59
60. 60
61. 61
62. 62
63. 63
64. 64
65. 65
66. 66
67. 67
68. 68
69. 69
70. 70
71. 71
72. 72
73. 73
74. 74
```
sub Tgetent {
    local($TERM) = @_;
    local($TERMCAP,$_,$entry,$loop,$field);

    # warn "Tgetent: no ospeed set" unless $ospeed;
    foreach $key (keys %TC) {
	delete $TC{$key};
    }
    $TERM = $ENV{'TERM'} unless $TERM;
    $TERM =~ s/(\W)/\\$1/g;
    $TERMCAP = $ENV{'TERMCAP'};
    $TERMCAP = '/etc/termcap' unless $TERMCAP;
    if ($TERMCAP !~ m:^/:) {
	if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
	    $TERMCAP = '/etc/termcap';
	}
    }
    if ($TERMCAP =~ m:^/:) {
	$entry = '';
	do {
	    $loop = "
	    open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\";
	    while (<TERMCAP>) {
		next if /^#/;
		next if /^\t/;
		if (/(^|\\|)${TERM}[:\\|]/) {
		    chop;
		    while (chop eq '\\\\') {
			\$_ .= <TERMCAP>;
			chop;
		    }
		    \$_ .= ':';
		    last;
		}
	    }
	    close TERMCAP;
	    \$entry .= \$_;
	    ";
	    eval $loop;
	} while s/:tc=([^:]+):/:/ && ($TERM = $1);
	$TERMCAP = $entry;
    }

    foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
	if ($field =~ /^\w\w$/) {
	    $TC{$field} = 1;
	}
	elsif ($field =~ /^(\w\w)#(.*)/) {
	    $TC{$1} = $2 if $TC{$1} eq '';
	}
	elsif ($field =~ /^(\w\w)=(.*)/) {
	    $entry = $1;
	    $_ = $2;
	    s/\\E/\033/g;
	    s/\\(200)/pack('c',0)/eg;			# NUL character
	    s/\\(0\d\d)/pack('c',oct($1))/eg;	# octal
	    s/\\(0x[0-9A-Fa-f][0-9A-Fa-f])/pack('c',hex($1))/eg;	# hex
	    s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
	    s/\\n/\n/g;
	    s/\\r/\r/g;
	    s/\\t/\t/g;
	    s/\\b/\b/g;
	    s/\\f/\f/g;
	    s/\\\^/\377/g;
	    s/\^\?/\177/g;
	    s/\^(.)/pack('c',ord($1) & 31)/eg;
	    s/\\(.)/$1/g;
	    s/\377/^/g;
	    $TC{$entry} = $_ if $TC{$entry} eq '';
	}
    }
    $TC{'pc'} = "\0" if $TC{'pc'} eq '';
    $TC{'bc'} = "\b" if $TC{'bc'} eq '';
}
```
Гениальный код.

Запостил: Arigato, 01 Ноября 2010

Tweet
Комментарии (58) RSS
- eth0 01.11.2010 19:03 # +3
  
  Несёте возмездие во имя Луны? Ну-ну.
  Ответить
  - KirAmp 01.11.2010 22:07 # 0
    
    воин в матросском костюме...
    Ответить
- Dummy00001 01.11.2010 19:11 # 0
  
  термкап руками парсить ... суровые будни Солярочных админов.
  Ответить
- Oleg_quadro 01.11.2010 19:35 # 0
  
  Мы поняли, что перл вам не нравится, поняли.
  
  Но повторюсь: "По существу надо, а не потому, что перл не нравится.",
  Надо расписать конкретно почему здесь плохой код, а не постить, потому что perl не нравится.
  
  Это я не чтоб вам надоесть, это я за чистоту говнокода.
  Ответить
  - Arigato 01.11.2010 19:38 # −3
    
    А вы не считаете это говнокодом?
    Да хотя бы на тело цикла гляньте:
    
    do { $loop = " open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\"; while (<TERMCAP>) { next if /^#/; next if /^\t/; if (/(^|\\|)${TERM}[:\\|]/) { chop; while (chop eq '\\\\') { \$_ .= <TERMCAP>; chop; } \$_ .= ':'; last; } } close TERMCAP; \$entry .= \$_; "; eval $loop; } while s/:tc=([^:]+):/:/ && ($TERM = $1);
    
    Это не говнокод?
    Ответить
    - Oleg_quadro 01.11.2010 19:42 # +1
      
      плюсанул код, считаю, что в продакшене не надо баловаться "$_", вызывая его явно или неявно.
      Добавь автор явные строки, было бы лучше.
      Ответить
      
      Oleg_quadro 01.11.2010 19:43 # −1
      
      явные переменные.
      Ответить
      
      Oleg_quadro 01.11.2010 19:48 # 0
      
      Хотя, добавлю: в маленьких блоках map и grеp всё же можно юзать "$_" )). Там это не так страшно.
      Ответить
      
      Arigato 01.11.2010 19:52 # +1
      
      Хорошо, скажу прямо: eval $loop; не смущает?
      Ответить
      
      Oleg_quadro 01.11.2010 19:53 # 0
      
      Смущает. Вот это говно.
      Ответить
      
      seonull 01.11.2010 20:44 # 0
      
      зачем тогда писать "По существу надо, а не потому, что перл не нравится."? было бы это написано на пыхе, тут бы все уже срали кирпичами и было бы +20 минимум.
      Ответить
      
      Oleg_quadro 01.11.2010 22:21 # 0
      
      Виноват, просто привык, что Arigato наезжает на перл, потому что он перл.
      Ответить
      
      bugmenot 01.11.2010 23:27 # +1
      
      Arigato уже не прёт.
      Ответить
      
      krushi 02.11.2010 01:03 # 0
      
      Не могу согласиться. Это исключительно вопрос стиля и соглашений в рамках проекта.
      Ответить
- Анонимус 01.11.2010 21:02 # +1
  
  парсить термкам рукам -- глупо. для этого есть Term::Cap.
  Обычно перловики (в отличии кстати от пхпшников) используют готовые модули, коих на CPANе пруд-пруди.
  Так что автор этого кода видимо совершенно не понимал сути перла, наверное он много писал на php.
  
  Хотя и этот код впринципе читаем.
  
  зы: интересно, как бы автор переписал этот код на другой прекрасный язык программирования
  Ответить
  - Arigato 01.11.2010 22:40 # −1
    
    > Так что автор этого кода видимо совершенно не понимал сути перла, наверное он много писал на php.
    
    Да, я тоже считаю, что автор данного кода не понимал сути перла и специализировался на php. Тем более, что этот код взят из файла lib/termcap.pl, поставляемого вместе с дистрибутивом Perl.
    
    # $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
    Ответить
    - krushi 02.11.2010 00:56 # +3
      
      Браво, 1992 год, очень актуально.
      
      ...А теперь открываем исходник и читаем, что написано в комментариях ниже этой самой строчки SVN:
      
      # This library is no longer being maintained, and is included for backward # compatibility with Perl 4 programs which may require it. # # In particular, this should not be used as an example of modern Perl # programming techniques.
      Ответить
      
      krushi 02.11.2010 00:58 # 0
      
      ...Снова боретесь с ветряными мельницами и считаете всех дурачками?
      Ответить
      
      Arigato 02.11.2010 08:29 # 0
      
      Ну да, и правда браво, если этот кусок говна до сих пор не исключен, а только планируют.
      При этом было интересно наблюдать за реакцией, когда выдвинули предположение, что это php-шник писал :)
      Ответить
      
      krushi 02.11.2010 10:13 # 0
      
      Перечитайте внимательно: "for backward compatibility".
      Ответить
      
      seonull 02.11.2010 11:33 # 0
      
      да ладно, не лукавьте - почти ведь все модули написаны в таком стиле.
      Ответить
      
      krushi 02.11.2010 11:50 # 0
      
      В перле около 500 стандартных модулей. Сколько исходников из этого числа вы прочитали, чтобы утверждать такое?
      Ответить
      
      seonull 02.11.2010 12:07 # 0
      
      что значит "такое"? то что перл "райт-онли" как бы общеизвестный факт. загляните в любой стандартный модуль и вы увидите:
      - злоупотребление "$_" - ставим галочку.
      - злоупотребление регекспами - ставим галочку.
      - предпочтение краткости удобочитаемости - ставим галочку.
      Ответить
      
      krushi 02.11.2010 12:25 # 0
      
      "Такое" относится к утверждению: "написаны в таком стиле"
      
      Согласен, "как бы общеизвестный факт".
      
      Что касается "галочек", то см: http://oreilly.com/catalog/9780596001735.
      Ответить
      
      seonull 02.11.2010 12:44 # 0
      
      ну да, примерно в таком стиле большинство модулей и написаны. сколько просмотрел? ну где-то с пол сотни случайно выбранных модулей. к чему этот вопрос? вы хотите сказать что оставшиеся 250 написаны кардинально иначе?
      Ответить
      
      krushi 02.11.2010 13:00 # −1
      
      К тому, что сегодняшняя стилистика отличается от стилистики 18-летней давности, а последняя была вполне приемлема для своего времени. Чтобы не быть голословным: сколько из ваших полсотни модулей содержат строковой eval?
      Ответить
      
      seonull 02.11.2010 13:23 # 0
      
      поиск по "eval $" вернул 101 результат. поздравляю.
      Ответить
      
      krushi 02.11.2010 13:43 # 0
      
      Не сходится. Поделитесь, pls, где и как искали.
      Ответить
      
      Arigato 02.11.2010 17:37 # +1
      
      Из стандартных модулей:
      
      sub validate { local($file,$test,$warnings,$oldwarnings); foreach $check (split(/\n/,$_[0])) { next if $check =~ /^#/; next if $check =~ /^$/; ($file,$test) = split(' ',$check,2); if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) { $testlist = $2; @testlist = split(//,$testlist); } else { @testlist = ('Z'); } $oldwarnings = $warnings; foreach $one (@testlist) { $this = $test; $this =~ s/(-\w\b)/$1 \$file/g; $this =~ s/-Z/-$one/; $this .= ' || warn' unless $this =~ /\|\|/; $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/; $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g; eval $this; last if $warnings > $oldwarnings; } } $warnings; }
      Ответить
      
      Arigato 02.11.2010 17:39 # +1
      
      Вот еще одна гениальная функция:
      
      sub assert { &panic("ASSERTION BOTCHED: $_[$[]",$@) unless eval $_[$[]; }
      Ответить
      
      da4ever 02.11.2010 19:05 # −1
      
      вот уже чем вам опять так не нравится перл?
      Ответить
      
      Arigato 02.11.2010 19:55 # −1
      
      При чем тут сам по себе перл? Или вы считаете, что это не есть кусок говна:
      
      foreach $one (@testlist) { $this = $test; $this =~ s/(-\w\b)/$1 \$file/g; $this =~ s/-Z/-$one/; $this .= ' || warn' unless $this =~ /\|\|/; $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/; $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g; eval $this; last if $warnings > $oldwarnings; }
      Ответить
      
      Анонимус 02.11.2010 23:28 # −1
      
      совершенно нормальный код.
      что Вас смущает? Регулярки?
      Ответить
      
      da4ever 02.11.2010 23:38 # +2
      
      я считаю, что вы пристали к этому языку как пьяный к радио.
      
      два ваших последних говнокода, как бы это вежливее сказать, не доставляют достаточно положительных эмоций. длинные треды про "перл - говно" то ли печальны, то ли унылы.
      
      именно поэтому появились вопросы:
      - "что вас так задело?",
      - "зачем вы тратите свое время на разбор стандартных модулей в поисках евалов и черезмеоного использования регеспов?",
      - "кому и что вы пытаетесь доказать?"
      
      да, пока только эти три.
      Ответить
      
      krushi 02.11.2010 19:45 # −1
      
      Это не модуль. Модулем называется другое.
      Ответить
      
      Анонимус 02.11.2010 23:29 # 0
      
      Товарищ просто не знает регулярок, и как только он их видит -- у него начинается баттхард.
      
      Можно подумать что регулярки в его любимом php пахнут как-то иначе
      Ответить
      
      krushi 02.11.2010 23:51 # −2
      
      У него разве PHP любимый?
      
      Я думаю, категоричность и необъективность оценок -- следствие... как бы покорректнее выразиться... профессиональной изолированности.
      Ответить
      
      Arigato 03.11.2010 09:01 # 0
      
      >
      Можно подумать что регулярки в его любимом php пахнут как-то иначе
      
      Регулярки в PHP мало чем от перловких отличаются.
      Ответить
      
      seonull 03.11.2010 09:27 # +1
      
      искал тоталом по *.пм в /либ и подкаталогах.
      Ответить
      
      krushi 03.11.2010 10:01 # +1
      
      Так я и думал, не там искали. В lib и ниже помимо стандартных лежат какие угодно модули, причем часто -- для разных версий Perl-а. На моем хосте, к примеру, там их 1208 штуки А вот если набрать:
      
      grep -r 'eval \$' /usr/lib/perl5/5.8.8/*.pm
      
      поолучится всего 3 результата. И в каждом случае eval абсолютно оправдан. К примеру, в модуле Benchmark.
      Ответить
      
      seonull 03.11.2010 19:35 # 0
      
      а я думал, что "помимо стандартных" лежат в \site\lib, не?
      Ответить
      
      krushi 04.11.2010 00:24 # −2
      
      ActivePerl для Win32? Если коротко, то -- нет.
      Ответить
      
      seonull 05.11.2010 09:49 # 0
      
      он самый.
      не знаю что у вас "нет", но у меня стандартные модули лежат именно в \lib. может под стандартными модулями вы понимаете какие-то труЪ красноглазые модули. лично я под стандартными имел ввиду модули идущие в составе дистрибутива.
      Ответить
      
      krushi 05.11.2010 11:01 # +1
      
      Ну допустим. Заходим туда:
      
      $ find ./ -name '*.pm' | wc -l 914 $ grep -r 'eval \$' ./*.pm | wc -l 11
      
      11 результатов на 914 файлов. Откуда число 101?
      Ответить
      
      seonull 05.11.2010 11:34 # 0
      
      base.pm
      Benchmark.pm
      Cwd.pm
      diagnostics.pm
      Errno.pm
      Fatal.pm
      JSON.pm
      SelfLoader.pm
      Shell.pm
      Thread.pm
      threads.pm
      version.pm
      Win32.pm
      ActiveState\ModInfo.pm
      ActiveState\Scineplex.pm
      Archive\Zip\BufferedFileHandle.pm
      Archive\Zip\MemberRead.pm
      Archive\Zip\MockFileHandle.pm
      Attribute\Handlers.pm
      Class\Struct.pm
      Compress\Zlib.pm
      Compress\Raw\Bzip2.pm
      Compress\Raw\Zlib.pm
      CPAN\Distribution.pm
      CPAN\Distroprefs.pm
      CPAN\InfoObj.pm
      CPAN\Kwalify.pm
      CPANPLUS\Dist\Build.pm
      CPANPLUS\Internals\Source.pm
      CPANPLUS\Shell\Classic.pm
      CPANPLUS\Shell\Default.pm
      Data\Dump.pm
      Data\Dumper.pm
      DBD\Proxy.pm
      Devel\Peek.pm
      Encode\Alias.pm
      ExtUtils\CBuilder.pm
      ExtUtils\Install.pm
      ExtUtils\Installed.pm
      ExtUtils\Packlist.pm
      File\CheckTree.pm
      File\Fetch.pm
      File\Spec.pm
      File\Spec\Cygwin.pm
      File\Spec\Epoc.pm
      File\Spec\Functions.pm
      File\Spec\Mac.pm
      File\Spec\OS2.pm
      File\Spec\Unix.pm
      File\Spec\VMS.pm
      File\Spec\Win32.pm
      HTML\AsSubs.pm
      HTML\Entities.pm
      HTTP\Status.pm
      IO\Dir.pm
      IO\Handle.pm
      IO\Seekable.pm
      IO\Socket\UNIX.pm
      List\Util.pm
      List\Util\PP.pm
      List\Util\XS.pm
      Locale\Maketext\GutsLoader.pm
      Math\Complex.pm
      Module\Build.pm
      Module\Build\Base.pm
      Module\Build\Config.pm
      Module\Build\ModuleInfo.pm
      Module\Build\Notes.pm
      Module\Build\PodParser.pm
      Module\Build\PPMMaker.pm
      Module\Build\Version.pm
      Module\Build\Platform\aix.pm
      Module\Build\Platform\Amiga.pm
      Module\Build\Platform\cygwin.pm
      Module\Build\Platform\darwin.pm
      Module\Build\Platform\Default.pm
      Module\Build\Platform\EBCDIC.pm
      Module\Build\Platform\MacOS.pm
      Module\Build\Platform\MPEiX.pm
      Module\Build\Platform\os2.pm
      Module\Build\Platform\RiscOS.pm
      Module\Build\Platform\Unix.pm
      Module\Build\Platform\VMS.pm
      Module\Build\Platform\VOS.pm
      Module\Build\Platform\Windows.pm
      Net\Ping.pm
      Net\Telnet.pm
      Scalar\Util.pm
      Scalar\Util\PP.pm
      SQL\Statement.pm
      Sub\Uplevel.pm
      Term\Cap.pm
      Test\Builder.pm
      Test\More.pm
      Test\Simple.pm
      Test\Builder\Module.pm
      Text\Diff\Table.pm
      threads\shared.pm
      Time\HiRes.pm
      version\vxs.pm
      Win32\TieRegistry.pm
      Ответить
      
      krushi 05.11.2010 12:34 # 0
      
      package Module::Build::Platform::Amiga; ... $VERSION = '0.3607'; $VERSION = eval $VERSION; ...
      
      И так почти везде. К алгоритмам это не имеет никакого отношения.
      Ответить
      
      Oleg_quadro 06.11.2010 15:04 # +1
      
      А зачем так делать?
      
      $VERSION = '0.3607';
      $VERSION = eval $VERSION;
      Ответить
      
      krushi 06.11.2010 18:27 # +1
      
      Первая строка нужна для совместимости с пакетами ExtUtils::MakeMaker, Module::Build и
      Module::Install, где парсеру правильнее давать строку. В то же время, в рантайме номер версии должен быть числом.
      
      Это необходимо, если версия выглядит как: 0.001_001. Без кавычек парсер установщика неверно проинтерпретирует ее как число 0.001001. Тогда как часть после подчеркивания здесь, по соглашению, является постфиксом, указывающим на девелоперский релиз.
      Ответить
      
      Oleg_quadro 06.11.2010 18:32 # 0
      
      Спасибо.
      Ответить
      
      Arigato 06.11.2010 22:30 # −5
      
      показать все, что скрыто
      $VERSION = '0.3607'; $VERSION = eval $VERSION;
      
      Ну тоже знатное говнецо.
      Ответить
      
      Arigato 02.11.2010 17:34 # −4
      
      > Что касается "галочек", то см: http://oreilly.com/catalog/9780596001735.
      
      Что-то не понял, вы спамите тут книжками по перлу за $49.99?
      Ответить
      
      krushi 02.11.2010 21:52 # 0
      
      Вы именуете "спамом" то, что в цивилизованном мире принято называть "ссылкой на первоисточник".
      Ответить
      
      Arigato 02.11.2010 22:19 # −4
      
      Ссылкой на магазин? Зачем мне магазин, кинусь сразу заказывать за $49.99? Или давайте ссылку на электронный ресурс, или не давайте вовсе.
      Ответить
      
      krushi 02.11.2010 22:33 # −1
      
      Нет, заказывать не обязательно, достаточно почитать аннотацию ("full description") или посмотреть картинку.
      Ответить
      
      Arigato 02.11.2010 23:17 # −2
      
      > достаточно почитать аннотацию ("full description") или посмотреть картинку.
      
      Т.е. достаточно глянуть только на обложку книги, как сразу все вопросы, заданные seonull отпадут сами собой?
      А ну ка, попробую. Смотрю на обложку книги... Вижу: верблюды, Perl... Ясно, рас там Perl, в таком случае вопросы отпадают. ДА и какие тут могут быть вопросы, если это перл :)
      Ответить
      
      krushi 02.11.2010 23:27 # 0
      
      >Вижу: верблюды, Perl..
      
      Точно глянули? А то там не верблюды, а собачка. Ниже текст на три экрана и оглавление, а под ними -- интервью с автором.
      Ответить
      
      Arigato 02.11.2010 17:31 # 0
      
      Хотите сказать, что данный модуль писался не перловщиком, а каким-то говно-пэхэпешником? :)
      Ответить
    - Анонимус 02.11.2010 15:40 # +4
      
      в 92м году в перле не было модулей для работы с термкап.
      в 92м году вообще писали немного иначе (поищите сырцы любой программы 1992го года).
      Кроме того этот файл не рефакторят (там написано что no longer being maintained).
      
      Вместо того, что бы искать файлы 20ти летней давности и смеятся над ними -- занялись бы лучше самообразованием, глядишь поумнеете.
      Ответить
Добавить комментарий
Ошибка компиляции комментария:

Гости могут высказаться только в понедельник, среду, четверг или воскресение
Семь раз отмерь — один отрежь, guest!

А не использовать ли нам bbcode?

[b]жирный[/b] — жирный

[i]курсив[/i] — курсив

[u]подчеркнутый[/u] — подчеркнутый

[s]перечеркнутый[/s] — перечеркнутый

[blink]мигающий[/blink] — мигающий

[color=red]цвет[/color] — цвет (подробнее)

[size=20]размер[/size] — размер (подробнее)

[code=<language>]some code[/code] (подробнее)

Проверочный код: *

Говнокод: по колено в коде.

Perl / Говнокод #4506

Комментарии (58) RSS

Добавить комментарий