API tools faq
paste
Advertisement
Green

Searcher

Green
May 11th, 2011
421
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
TCL 65.34 KB | None | 0 0
raw download clone embed print report
  1. #----------------------------------------------------------------------------
  2. # Searcher      - поиск на Yandex / Google / Youtube / Gogo / Wikipedia / Bing
  3. # * скрипт использует xml-выдачу результатов поиска, поэтому не зависит от изменений в дизайне сайтов
  4. # Включение:   .chanset #sochi +searcher
  5. # Включение:   .chanset #linuxtalks +searcher
  6. # Включение:   .chanset #swap-pro +searcher
  7. # Формат:     !y   [-число] [img:|изо:|sp:|орфо:] <запрос> - поиск в Яндексе
  8. #               !ya  [-число] [img:|изо:|sp:|орфо:] <запрос> - поиск в Яндексе (расширенный формат вывода)
  9. #               !yy  [-число] [img:|изо:] <запрос> - поиск в Яндексе (многострочный формат вывода)
  10. #               !go  [-число] [img:|video:][site:<сайт>] <запрос> - поиск в Gogo.ru       
  11. #               !goo [-число] [img:|video:][site:<сайт>] <запрос> - поиск в Gogo.ru    (многострочный формат вывода) 
  12. #                    *  Модификаторы: img: - поиск картинок, video: - поиск видео, site: - поиск внутри сайта
  13. #               !g   [-число] [img:|video:|news:|blog:|local:|spell:|tr:язык1-язык2][site:<сайт>] <запрос> - поиск в Google       
  14. #               !gg  [-число] [img:|video:|news:|blog:|local:][site:<сайт>] <запрос> - поиск в Google (многострочный формат вывода)      
  15. #                    *  Модификатор video: имеет несколько специальных параметров: -rate (рейтинг) -view (просмотры) -pop (популярные) -fav (фавориты) -comm (комментарии)
  16. #                       например: !g video:-rate выведет $maxres (3) самых рейтинговых клипа
  17. #                    *  Модификатор img: имеет несколько специальных параметров: ++ (большие картинки), +++ (очень большие картинки), +face (поиск лиц), +photo (поиск фотографий), +clip (клипарты), +line (рисунки)
  18. #                       например: !g img:кобзон +face ++ выведет большие фотографии Кобзона
  19. #               !yt  [-число] <запрос> - поиск в Youtube (аналог !gg video:)
  20. #               !ytt [-число] <запрос> - поиск в Youtube (многострочный формат вывода)
  21. #               !wkp [-страница] [-?] [.язык] [+]<запрос[#глава]> - поиск в Википедии (язык по умолчанию - .ru, параметр '-число' - номер страницы, '-?' - оглавление, '+' - вывод заголовка)
  22. #               !gbs [-число] <запрос> - поиск в Google Base
  23. #               !b   [-число] [img:|video:|news:|ans:|phone:|spell|tr:язык1-язык2] <запрос> - поиск в Bing    
  24. #               !bb   [-число] [img:|video:|news:|ans:|phone:] <запрос> - поиск в Bing (многострочный формат вывода)     
  25. #
  26. # Примеры:       !go img:putin или !go -2 site:zhurnal.lib.ru пупкин
  27. #               !gg -2 news:кондолиза или !g video:boney m
  28. #               !ya -2 лучшая поисковая система
  29. #               !yt -rate или !yt ufo
  30. #               !wkp -2 пушкин#Болдино
  31. #
  32. # Вопросы:       anaesthesia #eggdrop@Rusnet
  33. # Оффсайт:       http://weird.42-club.ru/tcl-skripty/
  34. #----------------------------------------------------------------------------
  35. # Требования:     Tcl версии не ниже 8.5
  36. #               eggdrop 1.6.18 / suzi patch
  37. # * для использования поиска в Яндексе теоретически необходимо зарегистрировать IP-адрес бота на http://xml.yandex.ru/ip.xml
  38. # * Параметры конфигурации можно вынести в отдельный файл, тогда при обновлении скрипта не будут сбрасываться настройки
  39. #   для этого создайте в каталоге со скриптом файл searcher.set в который впишите необходимые параметры из раздела "Первичные параметры конфигурации"
  40. #
  41. # v2.0          ! первый публичный релиз
  42. # v2.01         % добавлен отдельный бинд для Youtube, мелкие исправления
  43. # v2.1          + добавлен поиск по Википедии
  44. # v2.12         % исправлены ошибки в Google search и процедуре перекодировки символов, добавлена автоматическая очистка старых биндов
  45. # v2.13         + добавлен поиск в Google Base (поиск товаров и цен)
  46. # v2.15         + добавлен вывод одновременно нескольких результатов поиска (многострочный вывод, отдельными биндами для Yandex, Google, GoGo, Youtube и Bing)
  47. # v2.16         % исправления в Youtube и Wikipedia
  48. # v2.17         + добавлен выбор размера и типа картинок в поиске изображений Google
  49. # v2.2          + добавлен поиск по Bing
  50. # v2.21         + добавлена проверка орфографии Яндекс (!y sp:слово или !ys) и Google (!g sp:слово или !gs) ( * для гугля нужен package tls)
  51. # v2.22         + добавлен перевод через Google
  52. # v2.23         + добавлен поиск по фиксированным сайтам
  53. # v2.24         % приделана обработка канального флага +c (запрет цветовых кодов) и флага usecolors
  54.  
  55. package require Tcl     8.5
  56. package require http    2.7
  57.  
  58. namespace eval searcher {
  59.  
  60.     # сведения о разработчике скрипта, версии, дате последней модификации
  61.     variable author         "anaesthesia"
  62.     variable version        "02.24-public"
  63.     variable date           "22-Jun-2010"
  64.     variable unamespace     [namespace tail [namespace current]]
  65.  
  66. #----------------------------------------------------------------------------
  67. # Первичные параметры конфигурации
  68. #----------------------------------------------------------------------------
  69.     # префикс для команд (может быть пустой строкой)
  70.     variable pubprefix      {!}
  71.     variable pubflag        {-|-}
  72.  
  73.     # команды вызова (бинды)
  74.     # Яндекс (краткий вывод)
  75.     variable bya            "y"
  76.     # Яндекс (полный вывод)
  77.     variable byaf           "ya"
  78.     # Яндекс (многострочный вывод)
  79.     variable byal           "yy"
  80.     # Яндекс (орфография)
  81.     variable byao           "ys"
  82.     # Gogo.ru
  83.     variable bgogo          "go"
  84.     # Gogo.ru (многострочный вывод)
  85.     variable bgogol         "goo"
  86.     # Google
  87.     variable bgoog          "g г"
  88.     # Google (многострочный вывод)
  89.     variable bgoogl         "gg гг"
  90.     # Google (орфография)
  91.     variable bgoogo         "gs"
  92.     # Google Base
  93.     variable bbase          "gbs"
  94.     # Youtube
  95.     variable byt            "yt"
  96.     # Youtube (многострочный вывод)
  97.     variable bytl           "ytt"
  98.     # Wiki
  99.     variable bwiki          "wkp w"
  100.     # Bing
  101.     variable bbing          "b bing"
  102.     # Bing (многострочный вывод)
  103.     variable bbingl         "bb"
  104.  
  105.     # Альтернативные вики (викисайт должен поддерживать api версии не ниже 1.3)
  106.     # формат: bind {url}
  107.     variable altwiki
  108.     array set altwiki       {
  109.                             egg {wiki.egghelp.ru}
  110.                             lm {lurkmore.ru}
  111.                             }
  112.  
  113.     # Фиксированный поиск (поиск по конкретному сайту)
  114.     # формат: bind {url}
  115.     variable altsite
  116.     array set altsite       {
  117.                             u {packages.ubuntu.com}
  118.                             deb {getdeb.net}
  119.                             }
  120.  
  121.  
  122.     # количество выводимых результатов (не рекомендуется ставить более 5)
  123.     variable maxres         3
  124.  
  125.     # пауза между запросами, в течении которой сервис недоступен для использования, секунд
  126.     variable pause          5
  127.  
  128.     # поведение канального флага, если значение "" -- носит разрешающий
  129.     # характер, то есть если этот флаг установлен на канале -- сервис работает
  130.     # если "no" значения этой переменной указывают что флаг носит запрещающий
  131.     # характер и будучи установлен на канале запрещает работу сервиса
  132.     # (при этом сервис работает на ВСЕХ каналах, где не установлене этот флаг)
  133.     variable flagactas      ""
  134.    
  135.     # имя канального флага, служащего для включения/выключения сервиса на канале
  136.     # по умолчанию формируется из режима работы флага и имени неймспейса
  137.     # в данном случае режим работы запрещающий  
  138.     # при установке на канале запрещает работу
  139.  
  140.     variable chflag         "$flagactas$unamespace"
  141.     setudef  flag           $chflag
  142.  
  143. #----------------------------------------------------------------------------
  144. # Вторичные параметры конфигурации
  145. #----------------------------------------------------------------------------
  146.     variable msgprefix      ${pubprefix}
  147.     variable msgflag        ${pubflag}
  148.  
  149.     # pubcmd:имя_обработчика "вариант1 вариант2 ..."
  150.     # команда и её публичные варианты, строка в которой варианты разделены пробелом
  151.     variable pub:searcher       "$bya $byaf $byal $byao $bgogo $bgogol $bgoog $bgoogl $bgoogo $byt $bytl $bbase $bbing $bbingl $bwiki [array names altwiki] [array names altsite]"
  152.  
  153.     # такие же команды как для публичных алиасов
  154.     variable msg:searcher   ${pub:searcher}
  155.  
  156.     #* можно отключить приватные или публичные команды, указав в качестве алиасов пустую строку
  157.     #* или закоменнтировав объявление  variable [pub|msg]:handler "string ..."
  158.  
  159.     # какие идентификаторы используются для различения запросов
  160.     # доступны $unick, $uhost, $uchan
  161.     # обычное tcl выражение, позволяющие сформировать уникальный id для идентификации запроса.
  162.     variable requserid      {$uhost}
  163.    
  164.     # максимальное число ожидающих выполнения запросов для одного id
  165.     variable maxreqperuser  1
  166.  
  167.     # максимальное число ожидающих выполнения запросов
  168.     variable maxrequests    5
  169.    
  170.     # адрес прокси-сервера
  171.     # строка вида "proxyhost.dom:proxyport" или пустая строка, если прокси-сервис не используется
  172.     variable proxy          {}
  173.  
  174.     # вести лог запросов -- пустая строка лог не ведётся
  175.     # иначе форматированный вывод в лог
  176.     variable logrequests    {'$unick', '$uhost', '$handle', '$uchan', '$ustr'}
  177.    
  178.     # Команда вывода для публичного запроса, по умолчанию -- на канал
  179.     # доступны $uchan & $unick
  180.     variable pubsend        {PRIVMSG $uchan :}
  181.  
  182.     # Команда вывода для приватного запроса, по умолчанию -- приватное сообщение
  183.     # доступно только $unick ($uchan == $unick)
  184.     variable msgsend        {PRIVMSG $unick :}
  185.    
  186.     # команда вывода для ошибок/недоступности сервиса
  187.     # доступны $unick
  188.     variable errsend        {NOTICE $unick :}
  189.  
  190.     # Максимальное число редиректов с запрошенной страницы
  191.     variable maxredir       1
  192.    
  193.     # Таймаут запроса в миллисекундах, то есть 30 секунд
  194.     variable timeout        30000
  195.  
  196.     # сообщение о принятии запроса
  197.     variable err_ok         {}
  198.  
  199.     # сообщение о невозможности получить данные, разницы в ошибках не делается
  200.     # просто сообщается о невозможности их получить
  201.     variable err_fail       {к сожалению Ваш запрос не выполнен. Возможно не удалось связаться с интернет-сервисом.}
  202.  
  203.     # сообщение о заполненности очереди запросов
  204.     variable err_queue_full {в данное время очередь сервиса заполнена и не может выполнить Ваш запрос. Повторите попытку позже.}
  205.    
  206.     # сообщение о заполненности очереди для конкретного id
  207.     variable err_queue_id   {пожалуйста дождитесь обработки предыдущих запросов.}
  208.    
  209.     # сообщение о том что пауза между использованиями сервиса не истекла
  210.     # доступна переменная $timewait -- оставшееся время, по истечении которого
  211.     # сервис будет доступен
  212.     variable err_queue_time {пожалуйста повторите попытку позже. Сервис будет доступен для использования через $timewait сек.}
  213.    
  214. #----------------------------------------------------------------------------
  215. #  Внутренние переменные и код
  216. #----------------------------------------------------------------------------
  217.     # адрес, с которого происходит получение информации
  218.     variable        furlya      "http://xmlsearch.yandex.ru/xmlsearch"
  219.     variable        furlyi      "http://images-xmlsearch.yandex.ru/xmlsearch"
  220.     variable        furlys      "http://speller.yandex.net/services/spellservice/checkText?text="
  221.     variable        furlgo      "http://gogo.ru/xml"
  222.     variable        furlgg      "http://ajax.googleapis.com/ajax/services/search"
  223.     variable        furlyt      "http://gdata.youtube.com/feeds/api/"
  224.     variable        furlgb      "http://www.google.com/base/feeds/snippets"
  225.     variable        furlbi      "http://api.search.live.net/json.aspx?AppId=9F620C0348176DCFF5EA39AC1E923DC4C172C610"
  226.     variable        furlgs      "https://www.google.com/tbproxy/spell"
  227.     variable        furlgt      "http://ajax.googleapis.com/ajax/services/language/translate"
  228.     variable        furlgd      "http://ajax.googleapis.com/ajax/services/language/detect"
  229.  
  230.  
  231.     # очередь запросов
  232.     variable        reqqueue
  233.     array unset     reqqueue
  234.  
  235.     # последние таймстампы
  236.     variable        laststamp
  237.     array unset     laststamp
  238.  
  239. #---body---
  240.  
  241.     proc msg:searcher {unick uhost handle str} {
  242.         pub:searcher $unick $uhost $handle $unick $str
  243.         return
  244.     }
  245.  
  246.     proc pub:searcher {unick uhost handle uchan str} {
  247.         variable requserid ; variable fetchurl ; variable furlya ; variable furlyi ; variable furlgg ; variable furlgo ; variable furlyt ; variable furlgb ; variable furlbi ; variable furlys ; variable furlgs ; variable furlgt ; variable furlgd
  248.         variable chflag ; variable flagactas
  249.         variable errsend ; variable pubsend ; variable msgsend
  250.         variable unamespace ; variable maxres ; variable pubprefix
  251.         variable type ; variable ytype ; variable mpage ; variable query ; variable logrequests ; variable ext ; variable lng ; variable ya ; variable altwiki ; variable altsite ; variable bbing ; variable bbingl
  252.         variable bya ; variable byaf ; variable byal ; variable byao ; variable bgogo ; variable bgogol ; variable bgoog ; variable bgoogl ; variable bgoogo ; variable bbase ; variable byt ; variable bytl ; variable bwiki ; variable wlang ; variable wpage ; variable wparm ; variable wpart ; variable whdr
  253.  
  254.         set id [subst -noc $requserid]
  255.         set prefix [subst -noc $errsend]
  256.         if {$unick ne $uchan} {if {![channel get $uchan $chflag] ^ $flagactas eq "no" } {return}}
  257.         set why [queue_isfreefor $id]
  258.         if {$why != ""} {lput puthelp $why $prefix ; return}
  259.         set query ""
  260.  
  261. #---параметры
  262.         set ustr $str ; set lng 0
  263.         if {[string trimleft $::lastbind ${pubprefix}] in "$bya $byaf $byal $byao"} {
  264.             if {[regexp -nocase -- {^-[0]*(\d+)} $ustr -> mpage]} {regsub -- {-\d+\s+} $ustr "" ustr} {set mpage 1}
  265.             if {[string trimleft $::lastbind ${pubprefix}] in $byal} {set lng 1 ; set ndoc $maxres} {set ndoc 1}
  266.             if {[regexp -nocase -- {img:|image:|изо:} $ustr]} {
  267.                 regsub -all -- {img:|image:|изо:} $ustr "" ustr
  268.                 set query "<\?xml version=\"1.0\" encoding=\"windows-1251\"\?><request><query>[string trim [uenc $ustr]]</query><page>[expr {$mpage - 1}]</page><groupings><groupby attr=\"ih\" mode=\"deep\" groups-on-page=\"$ndoc\" docs-in-group=\"1\" /></groupings></request>"
  269.                 set fetchurl $furlyi ; set type 1 ; set ext 0
  270.             } elseif {[regexp -nocase -- {sp:|орфо:|орф:} $ustr] || [string trimleft $::lastbind ${pubprefix}] in "$byao"} {
  271.                 regsub -all -- {sp:|орфо:|орф:} $ustr "" ustr
  272.                 set fetchurl "$furlys[uencg $ustr]" ; set type 8
  273.             } {
  274.                 if {[string trimleft $::lastbind ${pubprefix}] in $byaf} {set ext 1} {set ext 0}
  275.                 set query "<\?xml version=\"1.0\" encoding=\"windows-1251\"\?><request><query>[uenc $ustr]</query><page>[expr {$mpage - 1}]</page><groupings><groupby attr=\"d\" mode=\"deep\" groups-on-page=\"$ndoc\" docs-in-group=\"1\" /></groupings></request>"
  276.                 set fetchurl $furlya ; set type 1
  277.             }
  278.         } elseif {[string trimleft $::lastbind ${pubprefix}] in "$bbing $bbingl "} {
  279.             if {[regexp -nocase -- {^-[0]*(\d+)} $ustr -> mpage]} {regsub -- {-\d+\s+} $ustr "" ustr} {set mpage 1}
  280.             if {[string trimleft $::lastbind ${pubprefix}] in $bbingl} {set lng 1 ; set bdoc $maxres} {set bdoc 1}
  281.             set btype "Web" ; set bopt "&Adult=Off&Web.Offset=[expr {$mpage - 1}]&Web.Count=$bdoc&Options=EnableHighlighting" ; set bsl "" ; set btl "" ; set bll "ru en fr de it es pt ar nl ja co pl"
  282.             if {[regexp -nocase -- {web:|веб:} $ustr]} {regsub -- {web:|веб:} $ustr "" ustr ; set btype "Web"}
  283.             if {[regexp -nocase -- {video:|vid:|видео:|вид:} $ustr]} {regsub -- {video:|vid:|видео:|вид:} $ustr "" ustr ; set btype "Video" ; set bopt "&Adult=Off&Video.Offset=[expr {$mpage - 1}]&Video.Count=$bdoc"}
  284.             if {[regexp -nocase -- {(?!trans:|tr:|перевод:)(..)\-(..)\s+} $ustr - bsl btl]} {regsub -- {(trans:|tr:|перевод:)(..)\-(..)\s+} $ustr "" ustr ; set btype "Translation" ; if {$bsl in $bll && $btl in $bll} {set bopt "&Translation.SourceLanguage=$bsl&Translation.TargetLanguage=$btl&Market=en-us"} {lput putserv "Языки: $bll" $prefix ; return}}
  285.             if {[regexp -nocase -- {spell:|sp:|орфо:} $ustr]} {regsub -- {spell:|sp:|орфо:} $ustr "" ustr ; set btype "Spell" ; set bopt "&Options=EnableHighlighting&Market=en-us"}
  286.             if {[regexp -nocase -- {phone:|тел:} $ustr]} {regsub -- {phone:|тел:} $ustr "" ustr ; set btype "PhoneBook" ; set bopt "&PhoneBook.Offset=[expr {$mpage - 1}]&PhoneBook.Count=$bdoc"}
  287.             if {[regexp -nocase -- {news:|новости:|нов:} $ustr]} {regsub -- {news:|новости:|нов:} $ustr "" ustr ; set btype "News" ; set bopt "&News.Offset=[expr {$mpage - 1}]&News.Count=$bdoc&Options=EnableHighlighting&Market=en-us"}
  288.             if {[regexp -nocase -- {answer:|ans:|ответ:|отв:} $ustr]} {regsub -- {answer:|ans:|ответ:|отв:} $ustr "" ustr ; set btype "InstantAnswer" ; set bopt "&Market=en-us"}
  289.             if {[regexp -nocase -- {image:|img:|изо:} $ustr]} {regsub -- {image:|img:|изо:} $ustr "" ustr ; set btype "Image" ; set bopt "&Image.Offset=[expr {$mpage - 1}]&Image.Count=$bdoc"}
  290.             set fetchurl "${furlbi}&Query=[uencg [string trim $ustr]]&Sources=$btype$bopt" ; set type 7
  291.         } elseif {[string trimleft $::lastbind ${pubprefix}] in "$bwiki [array names altwiki]"} {
  292.             if {[string trimleft $::lastbind ${pubprefix}] in [array names altwiki]} {
  293.                 set wlang [lindex [array get altwiki [string trimleft $::lastbind ${pubprefix}]] 1]
  294.             } {
  295.                 if {[regexp -nocase -- {\.(.*?)\s} $ustr - wlang]} {regsub -- {\.(.+?)\s} $ustr "" ustr} {set wlang "ru"}
  296.                 if {![regexp -- {\.} $wlang]} {set wlang "$wlang.wikipedia.org/w"}
  297.             }
  298.             if {[regexp -nocase -- {\-[0]*(\d+)\s*} $ustr - wpage]} {regsub -- {\-(\d+)\s*} $ustr "" ustr} {set wpage 1}   
  299.             if {[regexp -nocase -- {\+} $ustr]} {regsub -- {\+} $ustr "" ustr ; set whdr 1} {set whdr 0}   
  300.             if {[regexp -nocase -- {\-\?\s*} $ustr]} {regsub -- {\-\?\s*} $ustr "" ustr ; set wparm 1} {set wparm 0}   
  301.             if {[regexp -nocase -- {#(.*?)$} $ustr - wpart]} {regsub -- {#(.*?)$} $ustr "" ustr ; set wpart [string trim $wpart]} {set wpart ""}   
  302.                 set fetchurl "http://${wlang}/api.php?action=query&list=search&format=xml&srsearch=[uencg [string trim $ustr]]"
  303.                 set type 5
  304.         } elseif {[string trimleft $::lastbind ${pubprefix}] in "$bbase"} {
  305.             if {[regexp -nocase -- {^-[0]*(\d+)} $ustr -> mpage]} {regsub -- {-\d+\s+} $ustr "" ustr} {set mpage 1}
  306.             set fetchurl "${furlgb}?q=[uencg [string trim $ustr]]&start-index=$mpage&max-results=1" ; set type 6
  307.         } elseif {[string trimleft $::lastbind ${pubprefix}] in "$bgoog $bgoogl $bgoogo $byt $bytl [array names altsite]"} {
  308.             if {[regexp -nocase -- {^-[0]*(\d+)} $ustr -> mpage]} {regsub -- {-\d+\s+} $ustr "" ustr} {set mpage 1}
  309.             if {[string trimleft $::lastbind ${pubprefix}] in $bgoogl} {set lng 1}
  310.             if {[string trimleft $::lastbind ${pubprefix}] in $bytl} {set lng 1 ; set mpage [expr {$maxres * ($mpage - 1) + 1}]}
  311.             if {[string trimleft $::lastbind ${pubprefix}] in [array names altsite]} {set ustr "$ustr site:[lindex [array get altsite [string trimleft $::lastbind ${pubprefix}]] 1]"}
  312.             if {[regexp -nocase -- {spell:|sp:|орфо:} $ustr] || [string trimleft $::lastbind ${pubprefix}] in "$bgoogo"} {
  313.                 regsub -- {spell:|sp:|орфо:} $ustr "" ustr ; set type 8
  314.                 if {[catch {package require tls}] != 0} {putlog "\[searcher.tcl\] Package 'tls' не найден." ; return} {::http::register https 443 ::tls::socket}
  315.                 regsub -all -- {[][${}"\\]} $ustr {} ustr
  316.                 if {[regexp -- {[а-яА-ЯёЁ]} $ustr]} {set lns "ru"} {set lns "en"}
  317.                 if {[regexp -nocase -- {^-(.+?)\s} $ustr -> lng]} {regsub -- {^-(.+?)\s} $ustr "" ustr}
  318.                 set query "<spellrequest><text>[encoding convertto utf-8 $ustr]</text></spellrequest>"
  319.                 set fetchurl "${furlgs}?lang=$lns&hl=$lns"
  320.             } elseif {[regexp -nocase -- {trans:|tr:} $ustr] && [string trimleft $::lastbind ${pubprefix}] in "$bgoog"} {
  321.                 set lng5 [list ? ar bg hr cz dk nl en fi fr de gr hi it ja no pl pt ro ru es sv ca tl iw lv lt sr sk sl uk]
  322.                 set lni5 [list auto ar bg hr cs da nl en fi fr de el hi it ja no pl pt ro ru es sv ca tl iw lv lt sr sk sl uk]
  323.                 regsub -- {trans:|tr:} $ustr "" ustr ; set type 9
  324.                 regexp -nocase -- {^(.+?)-(.+?)\s(.+?)$} $ustr -> lang1 lang2 utxt
  325.                     if {[lsearch -exact $lng5 $lang1] == -1 || [lsearch -exact $lng5 $lang2] == -1} {
  326.                         lput putserv "\037Неверно выбран язык перевода\037. [join $lng5]" $prefix
  327.                         return
  328.                     } {
  329.                         set lang1 [lindex $lni5 [lsearch -exact $lng5 $lang1]] ; set lang2 [lindex $lni5 [lsearch -exact $lng5 $lang2]]
  330.                         set ustr $utxt
  331.                         set fetchurl "${furlgt}?v=1.0&q=[uencg $ustr]&langpair=${lang1}%7C${lang2}"
  332.                     }
  333.             } elseif {[regexp -nocase -- {det:|def:} $ustr] && [string trimleft $::lastbind ${pubprefix}] in "$bgoog"} {
  334.                 regsub -- {det:|def:} $ustr "" ustr ; set type 9
  335.                 set fetchurl "${furlgd}?v=1.0&q=[uencg [string trim $ustr]]"
  336.  
  337.             } elseif {[regexp -nocase -- {video:|видео:} $ustr] || [string trimleft $::lastbind ${pubprefix}] in "$byt $bytl"} {
  338.                 regsub -- {video:|видео:} $ustr "" ustr ; set type 4 ; set ytype 1
  339.                 if {[string match "*-rate*" $ustr]} {set fetchurl "${furlyt}standardfeeds/top_rated?start-index=$mpage&max-results=$maxres&racy=include" ; set ytype 2
  340.                 } elseif {[string match "*-fav*" $ustr]} {set fetchurl "${furlyt}standardfeeds/top_favorites?start-index=$mpage&max-results=$maxres&racy=include" ; set ytype 2
  341.                 } elseif {[string match "*-view*" $ustr]} {set fetchurl "${furlyt}standardfeeds/most_viewed?start-index=$mpage&max-results=$maxres&racy=include" ; set ytype 2
  342.                 } elseif {[string match "*-pop*" $ustr]} {set fetchurl "${furlyt}standardfeeds/most_popular?start-index=$mpage&max-results=$maxres&racy=include" ; set ytype 2
  343.                 } elseif {[string match "*-comm*" $ustr]} {set fetchurl "${furlyt}standardfeeds/most_discussed?start-index=$mpage&max-results=$maxres&racy=include" ; set ytype 2
  344.                 } {set fetchurl "${furlyt}videos?vq=[uencg $ustr]&orderby=relevance&start-index=$mpage&max-results=$maxres&racy=include"}
  345.             } {
  346.                 if {$mpage > 20} {set mpage 20}
  347.                 set pfix "web"
  348.                 if {[regexp -nocase -- {img:|image:|изо:} $ustr]} {
  349.                     regsub -- {img:|image:|изо:} $ustr "" ustr
  350.                     set pfix "images" ; set imgp "&imgsz=medium" ; set imgt ""
  351.                     if {[regexp -nocase -- {\+\+} $ustr]} {regsub -- {\+\+} $ustr "" ustr ; set imgp "&imgsz=xxlarge"}
  352.                     if {[regexp -nocase -- {\+\+\+} $ustr]} {regsub -- {\+\+\+} $ustr "" ustr ; set imgp "&imgsz=huge"}
  353.                     if {[regexp -nocase -- {\+face} $ustr]} {regsub -- {\+face} $ustr "" ustr ; set imgt "&imgtype=face"}
  354.                     if {[regexp -nocase -- {\+photo} $ustr]} {regsub -- {\+photo} $ustr "" ustr ; set imgt "&imgtype=photo"}
  355.                     if {[regexp -nocase -- {\+clip} $ustr]} {regsub -- {\+clip} $ustr "" ustr ; set imgt "&imgtype=clipart"}
  356.                     if {[regexp -nocase -- {\+line} $ustr]} {regsub -- {\+line} $ustr "" ustr ; set imgt "&imgtype=lineart"}
  357.                 } {set imgp "" ; set imgt ""}
  358.                 if {[regexp -nocase -- {blog:|блог:} $ustr]} {regsub -- {blog:|блог:} $ustr "" ustr ; set pfix "blogs"}
  359.                 if {[regexp -nocase -- {news:|новости:} $ustr]} {regsub -- {news:|новости:} $ustr "" ustr ; set pfix "news"}
  360.                 if {[regexp -nocase -- {loc:|local:|лок:} $ustr]} {regsub -- {loc:|local:|лок:} $ustr "" ustr ; set pfix "local"}
  361.                 if {[regexp {[а-яА-ЯёЁ]} $ustr]} {set prus "&tl=ru"} {set prus ""}
  362.                 set fetchurl "$furlgg/$pfix?v=1.0&start=[expr {$lng?[expr {$maxres * ($mpage - 1)}]:[expr {$mpage - 1}]}]&safe=off&q=[string trim [uencg $ustr]]$prus$imgp$imgt" ; set type 2
  363.             }
  364.         } {
  365.             if {[regexp -nocase -- {^-[0]*(\d+)} $ustr -> mpage]} {regsub -- {-\d+\s+} $ustr "" ustr} {set mpage 1}
  366.             if {[string trimleft $::lastbind ${pubprefix}] in $bgogol} {set lng 1}
  367.             set pfix ""
  368.             if {[regexp -nocase -- {img:|image:|изо:} $ustr]} {regsub -- {img:|image:|изо:} $ustr "" ustr ; set pfix "_images"}
  369.             if {[regexp -nocase -- {vid:|video:|видео:} $ustr]} {regsub -- {vid:|video:|видео:} $ustr "" ustr ; set pfix "_video"}
  370.             if {[regexp -nocase -- {site:(.+?)(?:\s|$)} $ustr -> insite]} {regsub -- "site:$insite" $ustr "" ustr ; set site "&site=[string trim [string map {"http://" "" "www" ""} $insite]]&g=0&d=0"} {set site ""}
  371.             set fetchurl "${furlgo}${pfix}?q=[uencg [string trim $ustr]]&sf=[expr {$lng?[expr {($maxres * ($mpage - 1)) + 1}]:$mpage}]$site" ; set type 3
  372.         }
  373.  
  374.         ::http::config -urlencoding cp1251 -useragent "Mozilla/4.0 (compatible; MSIE 4.01; Windows CE; PPC; 240x320)"  
  375.  
  376.             if {[string is space $ustr]} {
  377.                 set prefix [subst -noc $msgsend]
  378.                 lput puthelp "\002${pubprefix}[lindex $bya 0]\002 \[-число\] \[img:|sp:\] <запрос> - поиск в Яндексе :: \002${pubprefix}[lindex $byaf 0]\002 - расширенный вывод :: \002${pubprefix}[lindex $byal 0]\002 - многострочный вывод" $prefix
  379.                 lput puthelp "\002${pubprefix}[lindex $bgogo 0]\002 \[-число\] \[img:|video:\]\[site:<сайт>\] <запрос> - поиск в GoGo.ru :: \002${pubprefix}[lindex $bgogol 0]\002 - многострочный вывод" $prefix       
  380.                 lput puthelp "\002${pubprefix}[lindex $bgoog 0]\002 \[-число\] \[img:|video:|news:|blog:|local:|spell:|tr:lng1-lng2|det:\]\[site:<сайт>\] <запрос> - поиск в Google :: \002${pubprefix}[lindex $bgoogl 0]\002 - многострочный вывод :: ( [set r ""; foreach n [array names altsite] {append r "${pubprefix}$n "}]$r) - фиксированный поиск" $prefix       
  381.                 lput puthelp "\002${pubprefix}[lindex $byt 0]\002 \[-число\] <запрос> - поиск в Youtube :: \002${pubprefix}[lindex $bytl 0]\002 - многострочный вывод" $prefix      
  382.                 lput puthelp "\002${pubprefix}[lindex $bbase 0]\002 \[-число\] <запрос> - поиск в Google Base" $prefix    
  383.                 lput puthelp "\002${pubprefix}[lindex $bwiki 0]\002 ( [set r ""; foreach n [array names altwiki] {append r "${pubprefix}$n "}]$r) \[-страница\] \[-?\] \[\002.\002язык\] \[+\]<запрос\[#глава\]> - поиск в Википедиях" $prefix      
  384.                 lput puthelp "\002${pubprefix}[lindex $bbing 0]\002 \[-число\] \[img:|video:|news:|spell:|ans:|phone:|tr:lng1-lng2\] <запрос> - поиск в Bing :: \002${pubprefix}[lindex $bbingl 0]\002 - многострочный вывод" $prefix       
  385.             return
  386.             }
  387. putlog "$fetchurl"
  388.         if {$logrequests ne ""} {set logstr [subst -noc $logrequests] ; lput putlog $logstr "$unamespace: "}
  389.         if {[queue_add "$fetchurl" $id "[namespace current]::searcher:parser" [list $unick $uhost $uchan $ustr]]} {variable err_ok ; if {$err_ok ne ""} {lput puthelp "$err_ok." $prefix}} {variable err_fail ; if {$err_fail ne ""} {lput puthelp "$err_fail" $prefix}}
  390.  
  391.     return
  392.     }
  393.  
  394. #---parser
  395.     proc searcher:parser {errid errstr body extra} {
  396.         upvar $errid lerrid $errstr lerrstr ${body} lbody ${extra} lextra
  397.         variable err_fail ; variable pubsend ; variable msgsend ; variable errsend
  398.         variable maxres ; variable mpage ; variable ext ; variable lng ; variable type ; variable ytype ; variable wlang ; variable wpage ; variable wparm ; variable wpart ; variable whdr
  399.  
  400.         foreach {unick uhost uchan ustr} ${lextra} {break}
  401.         if {$lerrid ne {ok}} {lput putserv [subst -noc $err_fail] [subst -noc $errsend] ; return}
  402.         if {$uchan eq $unick} {set prefix [subst -noc $msgsend]} {set prefix [subst -noc $pubsend]}
  403.         if {[info exists ::sp_version]} {if {$type != 3} {regsub -all -- {(?x)[\xCC][\x81]} $lbody "'" lbody ; set str [encoding convertfrom utf-8 $lbody]} {set str [encoding convertfrom cp1251 $lbody]}} {set str $lbody}
  404.  
  405. #----------------------------------------------------------------------------
  406. ##---parser-specific------
  407. #----------------------------------------------------------------------------
  408.     if {$type == 1} {
  409.         regsub -all -- "\n|\t|\r" $str " " str
  410.         if {![regexp -- {<error code="(.*?)">(.+?)</error>} $str -> yerrc yerr]}    {set yerrc 0 ; set yerr ""}
  411.         if {![regexp -- {<found priority="all">(.+?)</found>} $str -> ytotal]}      {set ytotal ""}     {set ytotal "/$ytotal"}
  412.         if {![regexp -- {<city>(.+?)</city>} $str -> ycity]}                        {set ycity ""}      {set ycity "\00303$ycity\003 "}
  413.         if {![regexp -- {<weather>(.+?)</weather>} $str -> yweather]}               {set yweather ""}   {regsub -all -- "<.*?>" [sconv $yweather] " " yweather ; set yweather " - $yweather "}
  414.         if {![regexp -- {<spcctx>(.+?)</spcctx>} $str -> yspc]}                     {set yspc ""}       {regsub -all -- "<.*?>" [sconv $yspc] "" yspc ; set yspc " - $yspc "}
  415.         if {![regexp -- {<link>(.+?)</link>} $str -> ylink]}                        {set ylink ""}      {regsub -all -- "<.*?>" [sconv $ylink] "" ylink ; set ylink " - $ylink "}
  416.         if {![regexp -- {<linkusd>(.+?)</linkusd>} $str -> yusd]}                   {set yusd ""}       {regsub -all -- "<.*?>" [sconv $yusd] "" yusd ; set yusd " - $yusd "}
  417.         if {![regexp -- {<linkeur>(.+?)</linkeur>} $str -> yeur]}                   {set yeur ""}       {regsub -all -- "<.*?>" [sconv $yeur] "" yeur ; set yeur " - $yeur "}
  418.         set ylong [list] ; set yshort [list] ; set yext [list]
  419.         if {[regexp -- {<grouping.*?>(.+?)</grouping>} $str -> ygg]} {
  420.             regsub -all -- {<hlword.*?>} $ygg "\002" ygg ; regsub -all -- {</hlword>} $ygg "\002" ygg
  421.             regsub -all -- {</group>} $ygg "</group>\n" ygg
  422.             foreach yg [split $ygg \n] {
  423.                 if {![regexp -- {<url>(.+?)</url>} $yg -> yurl]}                        {set yurl ""}       {set yurl " @ \037\00312$yurl\037\003"}
  424.                 if {![regexp -- {<title>(.+?)</title>} $yg -> ytitle]}                  {set ytitle ""}     {set ytitle "\00305$ytitle\003"}
  425.                 if {![regexp -- {<domain>(.+?)</domain>} $yg -> ydomain]}               {set ydomain ""}    {set ydomain "\002$ydomain\002 "}
  426.                 if {![regexp -- {<headline>(.+?)</headline>} $yg -> yheadl]}            {set yheadl ""}     {set yheadl " - \00314$yheadl\003"}
  427.                 if {![regexp -- {<size>(.+?)</size>} $yg -> ysize]}                     {set ysize ""}
  428.                 if {![regexp -- {<charset>(.+?)</charset>} $yg -> ycharset]}            {set ycharset ""}
  429.                 if {![regexp -- {<mime-type>(.+?)</mime-type>} $yg -> ymime]}           {set ymime ""}
  430.                 if {![regexp -- {<modtime>(.+?)</modtime>} $yg -> ymtime]}              {set ymtime ""}     {set ymtime "([clock format [clock scan $ymtime] -format "%d-%m-%Y %H:%M:%S"])"}   
  431.                 if {![regexp -- {<passages>(.+?)</passages>} $yg -> ypassages]}         {set yp ""}         {set yp "" ; foreach {- yps} [regexp -all -inline {<passage>(.+?)</passage>} $ypassages] {regsub -all -- "<.*?>" [sconv $yps] "" yps ; append yp "\003 $yps "}}
  432.                 if {![regexp -- {<image-properties>(.+)</image-properties>} $yg -> yi]} {set yi ""}         {regexp -- {<original-width>(.*?)</original-width>.*?<original-height>(.*?)</original-height>} $yi -> yiw yih ; set yi " \00314\[ ${yiw}x${yih} - $ysize байт\]\003"}
  433.                 lappend ylong  "${ytitle}${yi}${yurl}"
  434.                 lappend yshort "${ycity}${yweather}${ylink}${yspc}${yusd}${yeur}$yp $yi $yurl"
  435.                 lappend yext   "\00314\[$ysize байт $ymtime $ymime / $ycharset\]\003 | ${ydomain}${ytitle}${yheadl}"
  436.             }
  437.             if {$lng} {lput putserv [sconv [sspace "\[Yandex/$mpage$ytotal\] :: [join $ylong " | "]"]] $prefix} {lput putserv [sconv [sspace "\[Yandex/$mpage$ytotal\] ::[lindex $yshort 0]"]] $prefix}
  438.             if {$ext} {lput putserv [sconv [sspace [lindex $yext 0]]] $prefix}
  439.         } {lput putserv "\[Yandex\] \037[sconv $yerr]\037 (err:$yerrc)" $prefix}
  440.     } ;#ya
  441.  
  442.     if {$type == 2} {
  443.         set gdata [json2dict $str]
  444.         regsub -all "<b>|</b>" $gdata "\002" gdata
  445.         if {$lng} {
  446.             set gout [list]
  447.             set gdl [lrange [dict get $gdata responseData results] 0 [expr {$maxres - 1}]]
  448.             if {[catch {set gnr "[dict get $gdata responseData cursor estimatedResultCount]/"}]} {set gnr ""}
  449.             if {[llength $gdl]} {
  450.                 foreach gd $gdl {
  451.                     set gt [dict get $gd GsearchResultClass]
  452.                     if {$gt eq "GwebSearch"}   {set got "Web" ; lappend gout [sconv "\00305[dict get $gd title]\003 @ \037\00312[dict get $gd unescapedUrl]\003\037"]}
  453.                     if {$gt eq "GblogSearch"}  {set got "Blog" ; lappend gout [sconv "\00305[catch {[dict get $gd title]}\003 @ \037\00312[catch {[dict get $gd postUrl]}\003\037"]}
  454.                     if {$gt eq "GnewsSearch"}  {set got "News" ; lappend gout [sconv "\00305[dict get $gd title]\003 @ \037\00312[dict get $gd unescapedUrl]\003\037"]}
  455.                     if {$gt eq "GlocalSearch"} {set got "Local" ; lappend gout [sconv "\00305[dict get $gd title]\003 @ \037\00312[dict get $gd url]\003\037"]}
  456.                     if {$gt eq "GimageSearch"} {set got "Image" ; lappend gout [sconv "\00305[dict get $gd title]\003 \00314\[[dict get $gd width]x[dict get $gd height]\]\003 @ \037\00312[dict get $gd unescapedUrl]\003\037"]}
  457.                 }
  458.             lput putserv "\[Google/[expr {($maxres * ($mpage - 1)) + 1}]..[expr {($maxres * ($mpage - 1)) + $maxres}]/${gnr}$got\] [join $gout " | "]" $prefix
  459.             } {lput putserv "\[Google\] \037Ничего не найдено\037." $prefix}
  460.         } {
  461.             set gd [lindex [dict get $gdata responseData results] 0]
  462.             if {$gd ne ""} {
  463.                 set gt [dict get $gd GsearchResultClass]
  464.                 if {$gt eq "GwebSearch"}   {lput putserv [sconv "\[Google/$mpage/[dict get $gdata responseData cursor estimatedResultCount]/Web\] \00305[dict get $gd title]\003 :: [dict get $gd content] @ \037\00312[dict get $gd unescapedUrl]\003\037"] $prefix}
  465.                 if {$gt eq "GblogSearch"}  {lput putserv [sconv "\[Google/$mpage/Blog\] \00305[dict get $gd title]\003 [dict get $gd author] :: [dict get $gd content] - [dict get $gd publishedDate] @ \037\00312[dict get $gd postUrl]\003\037"] $prefix}
  466.                 if {$gt eq "GnewsSearch"}  {lput putserv [sconv "\[Google/$mpage/[dict get $gdata responseData cursor estimatedResultCount]/News\] \00305[dict get $gd title]\003 :: [dict get $gd content] :: [dict get $gd publisher] :: [dict get $gd location] [dict get $gd publishedDate] @ \037\00312[dict get $gd unescapedUrl]\003\037 [expr {[dict get $gd clusterUrl] eq "" ? [set cu ""] : [set cu "<= \037\00312[dict get $gd clusterUrl]\003\037"]}]"] $prefix}
  467.                 if {$gt eq "GlocalSearch"} {set r "" ; foreach {t n} [join [catch {[dict get $gd phoneNumbers]}]] {append r "$n "} ; lput putserv [sconv "\[Google/$mpage/Local\] \00305[dict get $gd title]\003 :: ${r}[dict get $gd streetAddress] [dict get $gd city] [dict get $gd region] [dict get $gd country] :: [dict get $gd lat]-[dict get $gd lng] @ \037\00312[dict get $gd url]\003\037"] $prefix}
  468.                 if {$gt eq "GimageSearch"} {lput putserv [sconv "\[Google/$mpage/[dict get $gdata responseData cursor estimatedResultCount]/Images\] \00305[dict get $gd title]\003 :: [dict get $gd content] \00314\[[dict get $gd width]x[dict get $gd height]\]\003 @ \037\00312[dict get $gd unescapedUrl]\003\037 <= \037\00312[dict get $gd originalContextUrl]\003\037"] $prefix}
  469.             } {lput putserv "\[Google\] \037Ничего не найдено\037." $prefix}
  470.         }
  471.     } ;#google
  472.  
  473.     if {$type == 3} {
  474.         regsub -all -- "\n|\t|\r" $str "" str
  475.         if {![regexp -- {<totalWebPages>(.+?)</totalWebPages>} $str -> gtwp]}   {set gtwp 0}
  476.         if {![regexp -- {<totalSites>(.+?)</totalSites>} $str -> gts]}          {set gts 0}
  477.         if {![regexp -- {<startIndex>(.+?)</startIndex>} $str -> gsi]}          {set gsi 0}
  478.         if {$gtwp > 0 && $gts > 0} {
  479.             regsub -all "<b>|</b>" [sconv $str] "\002" str
  480.             regsub -all -- "</item>" $str "</item>\n" str
  481.             set gres [list] ; set gresi [list] ; set gresv [list]
  482.             foreach g [split $str \n] {
  483.                 if {[regexp -- {<title>(.*?)</title>.*?<link>(.+?)</link>.*?<description>(.*?)</description>} $g -> gt gl gd]} {if {$lng} {lappend gres "\00305$gt\003 @ \037\00312$gl\003\037 |"} {lappend gres "\00305$gt\003 :: $gd @ \037\00312$gl\003\037"}}
  484.                 if {[regexp -- {<Url>(.*?)</Url>.*?<name>(.*?)</name>} $g -> gvu gvn]} {lappend gresv "\00305$gvn\003 @ \037\00312$gvu\003\037 |"}
  485.                 if {[regexp -- {<imageUrl>(.+?)</imageUrl>.*?<size>(.*?)</size>.*?<width>(.*?)</width>.*?<height>(.*?)</height>.*?<description>(.*?)</description>} $g -> gu gs gw gh gd]} {lappend gresi "\00305$gd\003 \00314\[${gw}\x${gh} - $gs байт\]\003 @ \037\00312http://$gu\003\037 |"}
  486.             }
  487.         }
  488.             if {$gtwp > 0 && $gtwp >= $mpage} {lput putserv "\[GoGo/[expr {$lng?[set gsi "$gsi..[expr {$gsi + $maxres - 1}]"]:$gsi}]/$gtwp\($gts\)\] :: [expr {$lng?[sspace [string trimright [join [lrange $gres 0 [expr {$maxres - 1}]]] "|"]]:[sspace [lindex $gres 0]]}][sspace [string trimright [join [lrange $gresi 0 [expr {$maxres - 1}]]] "|"]][sspace [string trimright [join [lrange $gresv 0 [expr {$maxres - 1}]]] "|"]]" $prefix} {lput putserv "\[GoGo\] \037Ничего не найдено\037." $prefix}
  489.     } ;#gogo
  490.  
  491.     if {$type == 4} {
  492.     regsub -all -- "\n" $str "" str
  493.     regsub -all -- "</entry>" $str "</entry>\n" str
  494.     if {![regexp -- {^(.+?)<entry>} $str -> yhead]} {lput putserv "\[Youtube\] \037Ничего не найдено\037." $prefix ; return}
  495.     regexp -- {<openSearch:totalResults>(.+?)</openSearch:totalResults>} $yhead -> ytotal
  496.     regexp -- {<title type='text'>(.+?)</title>} $yhead -> ytitle
  497.     regsub -- {^(.+?)<entry>} $str "" str
  498.  
  499.     set res [list] ; set cnt 0 ; set ytlong "" ; set ytshort "" ; set ykeyw "" ; set ydur "" ; set ycat ""
  500.     foreach yd [split $str \n] {
  501.         regexp -- {<published>(.+?)</published>} $yd -> ydate
  502.         regexp -- {<title type='text'>(.+?)</title>} $yd -> ytshort
  503.         regexp -- {<content type='text'>(.+?)</content>} $yd -> ytlong
  504.         regexp -- {<link rel='alternate' type='text/html' href='(.+?)'/>} $yd -> ylink
  505.         regexp -- {<media:keywords>(.+?)</media:keywords>} $yd -> ykeyw
  506.         regexp -- {<yt:duration seconds='(.+?)'/>} $yd -> ydur
  507.         regexp -- {<media:category.*?'>(.+?)</media:category>} $yd -> ycat
  508.         if {![regexp -- {<yt:statistics.*?viewCount='(.+?)'.*?/>} $yd -> yview]} {set yview "-"}
  509.         if {![regexp -- {<yt:statistics.*?favoriteCount='(.+?)'.*?/>} $yd -> yfav]} {set yfav "-"}
  510.         if {![regexp -- {<gd:rating.*?numRaters='(.+?)'.*?/>} $yd -> yraten]} {set yraten  "-"}
  511.         if {![regexp -- {<gd:rating.*?average='(.+?)'.*?/>} $yd -> yrate]} {set yrate "-"}
  512.         if {$ytype == 1 && !$lng} {
  513.                 lappend res "\[Youtube/$mpage/$ytotal\] :: \00305$ytshort\003 :: [expr {[string length $ytlong] > 300 ? [set ytlong "[string range $ytlong 0 300] ..."] : [set ytlong $ytlong]}] :: \00314($ykeyw)\003 :: \[\002T\002:[clock format $ydur -format "%M:%S"]/\002R\002:${yrate}($yraten)/\002V\002:$yview/\002F\002:$yfav/\002A\002:[clock format [clock scan [string range $ydate 0 9]] -format %d-%m-%Y]/\002$ycat\002\] \@ \037\00312$ylink\003\037"
  514.                 lput putserv "[sconv [join $res]]" $prefix ; break
  515.         } {
  516.             incr cnt
  517.             lappend res "\00305$ytshort\003 @ \037\00312$ylink\003\037 |"  
  518.             if {$cnt == $maxres} {break}
  519.         }
  520.     }
  521.         if {$ytype == 0} {lput putserv "\[Youtube/$ytotal\] :: [sconv [join $res]]" $prefix}
  522.         if {$ytype == 1 && $lng} {lput putserv "\[Youtube/$mpage..[expr {$mpage + ($maxres - 1)}]/$ytotal\] :: [sconv [join $res]]" $prefix}
  523.         if {$ytype == 2} {lput putserv "\[Youtube/\002$ytitle\002\] :: [sconv [join $res]]" $prefix}
  524.     } ;#ytube
  525.  
  526.     if {$type == 5} {
  527.         if {[regexp -- {<search>(.+?)</search>} $str -> wsearch]} {
  528.             regsub -all -- "\n|\t|\r" $str "" str
  529.             set wpg [list]
  530.             foreach {- res} [regexp -all -inline -- {title=\"(.+?)\".*?/>} $wsearch] {lappend wpg $res}
  531.             queue_add "http://${wlang}/api.php?action=query&format=xml&prop=info%7Crevisions&rvprop=timestamp%7Ccontent&rvlimit=1&redirects&titles=[uencg [lindex $wpg 0]]" [unixtime] "[namespace current]::searcher:parser" [list $unick $uhost $uchan $wpg]
  532.         } elseif {[regexp -- {<page.*?title=\"(.+?)\".*?touched=\"(.+?)\".*?length=\"(.+?)\">} $str -> ptitle pdate psize]} {
  533.             set pdate [string map {T " " Z ""} $pdate]
  534.             regexp -- {<rev timestamp.*?>(.+?)</rev>} $str -> ptext
  535.             set ptext [string map {&lt; < &gt; > nbsp; " " &lt;s&gt; \00315 &lt;/s&gt; \003} $ptext]
  536.             regsub -all -- {<ref>.*?</ref>} $ptext "" ptext
  537.             regsub -all -- {<.*?>} $ptext "" ptext
  538.             regsub -all -- {'''} $ptext {"} ptext
  539.             regsub -all -- {^(={2,5})\s*(.+?)\s*(={2,5})} $ptext "\\1 \\2 \\3" ptext
  540.  
  541.             if {$wpart ne ""} {
  542.                 set wstart [string first "== $wpart ==" $ptext]
  543.                 #set wend [string first "== " $ptext $wstart+[string length $wpart]]
  544.                 set ptext [string range $ptext $wstart end]
  545.             }
  546.  
  547.             set wres "" ; set wtoc [list]
  548.             foreach pline [split $ptext \n] {
  549.                 if {![regexp -- {^\s*(\||\!)} $pline]} {
  550.                     if {![regexp -- {^\[\[.*?\:.*$} $pline]} {
  551.                         regsub -all -- {\[\[(?:[^\[\]]*?\||)([^\[\]]*)\]\]} $pline "\00314\\1\003" pline
  552.                         regsub -all -- {\[\[(.*?)\]\]} $pline "\00312\\1\003" pline
  553.                         regsub -all -- {\{\{СС\|(\d+)\|(.+?)\|(\d+)\|(\d+)\|(.+?)\}\}} $pline  "\\1 \\2 (\\4 \\5) \\3" pline
  554.                         regsub -all -- {\{\{.*?\|.*?\|.*?\}\}} $pline "" pline                 
  555.                         regsub -all -- {\{\{(?:[^\{\}]*?\|)([^\{\}]*)\}\}} $pline "\00314\\1\003" pline
  556.                         regsub -all -- {\{\{.*?\}\}} $pline "" pline
  557.                         if {[regexp -- {^==\s*(.+?)\s*==} $pline -> toc]} {lappend wtoc [string map {= ""} $toc]}
  558.                         regsub -all -- {(?:\={2,4})\s*(.*?)\s*(?:\={2,4})} $pline "\002 * \002\037\\1\037 " pline
  559.                         regsub -all -- {^(\*{1,3}\s*|#{1,3}\s*)} $pline " \002\\1\002 " pline
  560.                         regsub -all -- {\[http://(.+?)\s(.*?)\]} $pline " \002*\002 \037\00312http://\\1\003\037 - \\2" pline
  561.                         append wres "$pline "
  562.                     }
  563.                 } elseif {$whdr && [regexp -- {^\s*\|\s*(.+?)\s*\=\s*(.+?)$} $pline -> wh wd]} {
  564.                     regsub -all -- {\{\{.*?\|(\d+)\|(.+?)\|(\d+)\|(\d+)\|(.+?)\}\}} $wd "\\1 \\2 (\\4 \\5) \\3" wd
  565.                     regsub -all -- {\[\[(?:[^\[\]]*?\||)([^\[\]]*)\]\]} $wd "\00314\\1\003" wd
  566.                     regsub -all -- {\[http://(.+?)\s(.*?)\]} $pline "\037\00312http://\\1\003\037 - \\2" pline
  567.                     append wres "$wh - $wd / "
  568.                 }
  569.             }
  570.  
  571.             set wplen 220
  572.             regsub -all -- "\n|\t|\r" $wres " " wres
  573.             regsub -all -- {\{\{.*?\}\}} $wres "" wres
  574.             set ptxt [sspace [sconv [string range $wres [expr {($wpage - 1) * $wplen}] [expr {(($wpage - 1) * $wplen) + $wplen}]] 0]]
  575.             if {$wparm} {lput putserv "\002ToC\002: [join $wtoc " :: "]" $prefix ; return}
  576.             if {$wpage == 1 && $wpart eq ""} {
  577.                 set ptxt "\[Wiki/стр.:${wpage}/[expr {([string length $wres] / 220) + 1}]\] \002$ptitle\002 :: ${ptxt}"
  578.                 if {[string length $ptxt] < $wplen} {set cont ""} {set cont " <...>"}
  579.                 lput putserv "${ptxt}$cont" $prefix
  580.                 lput putserv "\037\00312http://[string map {"/w" "/wiki"} ${wlang}]/[uencg [string map {" " "_"} $ptitle]]\003\037" $prefix
  581.                 if {[llength [lrange $ustr 1 end]]} {lput putserv "\037Еще найдено\037: [sconv [join [lrange $ustr 1 end] " / "]]" $prefix}  
  582.             } {
  583.                 if {[string length $ptxt] < $wplen} {set cont ""} {set cont " <...>"}
  584.                 lput putserv "\[стр.:${wpage}/[expr {([string length $wres] / 220) + 1}]\] :: ${ptxt}$cont" $prefix
  585.             }
  586.         } else {lput putserv "\[Wiki\] \037Ничего не найдено\037." $prefix ; return}
  587.     } ;#wiki
  588.  
  589.     if {$type == 6} {
  590.         regsub -all -- "\n" $str "" str
  591.         regsub -all -- "</entry>" $str "</entry>\n" str
  592.  
  593.         if {![regexp -- {^(.+?)<entry>} $str -> ghead]} {lput putserv "\[GBase\] \037Ничего не найдено\037." $prefix ; return}
  594.         regexp -- {<openSearch:totalResults>(.+?)</openSearch:totalResults>} $ghead -> gtotal
  595.         regexp -- {<title type='text'>(.+?)</title>} $ghead -> gtitle
  596.         regsub -- {^(.+?)<entry>} $str "" str
  597.  
  598.         foreach gd [split $str \n] {
  599.             if {[regexp -- {<published>(.+?)</published>} $gd -> gdate]}                    {set gdate [frmd $gdate]} {set gdate ""}
  600.             if {[regexp -- {<title type='(?:text|html)'>(.+?)</title>} $gd -> gsdesc]}      {set gsdesc $gsdesc} {set gsdesc ""}
  601.             if {[regexp -- {<content type='(?:text|html)'>(.+?)</content>} $gd -> gldesc]}  {set gldesc $gldesc} {set gldesc ""}
  602.             if {[regexp -- {<link rel='alternate'.*?href='(.+?)'/>} $gd -> glink]}          {regexp -- {loc=(.*?)$} $glink -> glink ; regsub -- {^.*?mpre=} $glink "" glink ; set glink [sconv [string map {"%3A" ":" "%2F" "/"} $glink]]} {set glink ""}
  603.  
  604.             if {[regexp -- {<g:condition type='text'>(.+?)</g:condition>} $gd -> gcond]}    {set gcond "<$gcond>"} {set gcond ""}
  605.             if {[regexp -- {<g:product_type type='text'>(.+?)</g:product_type>} $gd -> gprod]}  {set gprod "\[[sconv $gprod]\]"} {set gprod ""}
  606.             if {[regexp -- {<author><name>(.+?)</name>} $gd -> ganame]}                     {set ganame "$ganame"} {set ganame ""}
  607.             if {[regexp -- {<g:price type=.*?>(.+?)</g:price>} $gd -> gprice]}              {set gprice "(\037$gprice\037) "} {set gprice ""}
  608.  
  609.             lput putserv "[sconv [sspace "\[GBase/$mpage/$gtotal\] \002::\002 \00305$gsdesc\003 \002::\002 $gldesc \002::\002 $ganame $gcond $gprice $gprod"]]" $prefix
  610.             lput putserv "\037\00312$glink\003\037" $prefix
  611.             break
  612.         }
  613.     } ;# Google Base
  614.  
  615.     if {$type == 7} {
  616.         set bdata [json2dict $str]
  617.         regsub -all -- {\uE000|\uE001} $bdata "\002" bdata
  618.         if {[dict exists $bdata SearchResponse Errors]} {lput putserv "\[Bing\] \037Ничего не найдено\037.([join [dict get $bdata SearchResponse Errors]])" $prefix ; return} {
  619.             set bit [lindex [dict keys [dict get $bdata SearchResponse]] 2]
  620. #putlog "bit - $bit"
  621.             if {[dict exists $bdata SearchResponse Query AlterationOverrideQuery]} {lput putserv "[dict get $bdata SearchResponse Query AlterationOverrideQuery]" $prefix}
  622.             if {![dict exists $bdata SearchResponse $bit Total] || [dict get $bdata SearchResponse $bit Total] == 0} {if {$bit ne "Translation" && $bit ne "Spell"} {lput putserv "\[Bing\] \037Сервер вернул недостаточно данных\037." $prefix ; return}}
  623.             if {$lng} {
  624.                 set bout [list]
  625.                 set bdl [lrange [dict get $bdata SearchResponse $bit Results] 0 [expr {$maxres - 1}]]
  626.                 if {[catch {set bnr "[dict get $bdata SearchResponse $bit Total]/"}]} {set bnr ""}
  627.                 if {[llength $bdl]} {
  628.                     foreach bd $bdl {
  629.                         if {$bit eq "Web"} {lappend bout [sconv "\00305[dict get $bd Title]\003 @ \037\00312[dict get $bd Url]\003\037"]}
  630.                         if {$bit eq "Video"} {lappend bout [sconv "\00305[dict get $bd Title]\003 @ \037\00312[dict get $bd PlayUrl]\003\037"]}
  631.                         if {$bit eq "Image"} {lappend bout [sconv "\00305[dict get $bd Title]\003 :: [dict get $bd Width]x[dict get $bd Height] @ \037\00312[dict get $bd MediaUrl]\003\037"]}
  632.                         if {$bit eq "News"}  {lappend bout [sconv "\00305[dict get $bd Title]\003 (\00314[dict get $bd Source]\003 / [clock format [clock scan [string map {T " " Z ""} [dict get $bd Date]]] -format "%d-%h-%Y %H:%M" -locale ru]) :: \[[expr {![dict get $bd BreakingNews] ? [set bbn "N"] : [set bbn "\00304B\003"]}]\] @ [expr {[dict exists $bd Url] ? [set nurl "\037\00312[dict get $bd Url]\003\037"] : [set nurl " --- "]}]"]}
  633.                     }
  634.                 if {[llength $bout]} {lput putserv "\[Bing/[expr {($maxres * ($mpage - 1)) + 1}]..[expr {($maxres * ($mpage - 1)) + $maxres}]/${bnr}$bit\] [join $bout " | "]" $prefix} {lput putserv "\037Многострочный вывод не поддерживается\037 (пока...)" $prefix}
  635.                 } {lput putserv "\037Ничего не найдено\037." $prefix}
  636.             } {
  637.                 set bd [lindex [dict get $bdata SearchResponse $bit Results] 0]
  638.                 if {$bit eq "Web"} {lput putserv [sconv "\[Bing/$mpage/[dict get $bdata SearchResponse $bit Total]/Web\] \00305[dict get $bd Title]\003 :: [expr {[dict exists $bd Description] ? [dict get $bd Description] : [set bds ""]}] [expr {[dict exists $bd DateTime] ? [set wdt "([clock format [clock scan [string map {T " " Z ""} [dict get $bd DateTime]]] -format "%d-%h-%Y %H:%M" -locale ru])"] : [set wdt ""]}] @ \037\00312[dict get $bd Url]\003\037"] $prefix}
  639.                 if {$bit eq "Video"} {lput putserv [sconv "\[Bing/$mpage/[dict get $bdata SearchResponse $bit Total]/Video\] \00305[dict get $bd Title]\003 :: ([dict get $bd SourceTitle]) @ \037\00312[dict get $bd PlayUrl]\003\037 ([clock format [expr {[dict get $bd RunTime] / 1000}] -format "%Mm %Ss"])"] $prefix}
  640.                 if {$bit eq "Translation"} {lput putserv [sconv "\[Bing/Translate\] :: [dict get $bd TranslatedTerm]"] $prefix}
  641.                 if {$bit eq "Spell"} {lput putserv [sconv "\[Bing/Spell\] :: [dict get $bd $bit Value]"] $prefix}
  642.             if {$bit eq "PhoneBook"} {lput putserv [sconv "\[Bing/[dict get $bdata SearchResponse $bit Total]/Phone\] :: [dict get $bd $bit Results]"] $prefix}
  643.                 if {$bit eq "News"} {lput putserv [sconv "\[Bing/$mpage/[dict get $bdata SearchResponse $bit Total]/News\] \00305[dict get $bd Title]\003 (\00314[dict get $bd Source]\003 / [clock format [clock scan [string map {T " " Z ""} [dict get $bd Date]]] -format "%d-%h-%Y %H:%M" -locale ru]) :: [dict get $bd Snippet] \[[expr {![dict get $bd BreakingNews] ? [set bbn "N"] : [set bbn "\00304B\003"]}]\] @ [expr {[dict exists $bd Url] ? [set nurl "\037\00312[dict get $bd Url]\003\037"] : [set nurl " --- "]}]"] $prefix}
  644.                 if {$bit eq "InstantAnswer"} {lput putserv [sconv "\[Bing/$mpage/[dict get $bdata SearchResponse $bit Total]/Answer\] \00305[dict get $bd Title]\003 ([dict get $bd Attribution] / [dict get $bd ContentType]) :: [expr {[dict exists $bd InstantAnswerSpecificData] ? [set asd "[dict get $bd InstantAnswerSpecificData]"] : [set asd ""]}] @ [expr {[dict exists $bd Url] ? [set nurl "\037\00312[dict get $bd Url]\003\037"] : [set nurl " --- "]}]"] $prefix}
  645.                 if {$bit eq "Image"} {lput putserv [sconv "\[Bing/$mpage/[dict get $bdata SearchResponse $bit Total]/Image\] \00305[dict get $bd Title]\003 :: [dict get $bd Width]x[dict get $bd Height] @ \037\00312[dict get $bd Url]\003\037 -> \037\00312[dict get $bd MediaUrl]\003\037"] $prefix}
  646.             }
  647.         }
  648.     } ;# Bing
  649.  
  650.     if {$type == 8} {
  651.         if {[regexp -- {suggestedlang="(.+?)"} $str -> ln]} {set ln "\[$ln\] "} {set ln ""}
  652.         if {[regexp -nocase -- {<spellresult.*?>(.*?)</spellresult>} $str -> gd]} {
  653.         set spt "Google" ; set t ""
  654.             set gd [string map {\t " " "</c>" \n "</error>" \n} $gd]
  655.             foreach gl [split $gd \n] {
  656.                 if {[regexp -- {<c o="(\d+)" l="(\d+)" s="(\d+)">(.*?)$} $gl -> s l q w]} {
  657.                     set w0 [string range $ustr $s [expr {$s + $l}]]
  658.                         if {![string is space $w]} {
  659.                             append t "\"$w0\"" " \"\037[string trim $w0]\037 ([join [split [string trim $w]] ", "]) \" "
  660.                         } {
  661.                             append t "\"$w0\"" " \"\037[string trim $w0]\037 \" "
  662.                         }
  663.                 }
  664.                 if {[regexp -- {<error .*?pos="(\d+)".*?len="(\d+)".*?>} $gl -> s l]} {
  665.                     set spt "Yandex" ; set w ""
  666.                     regexp -- {<word>(.*?)</word>} $gl -> w0
  667.                     foreach {- r} [regexp -all -inline -- {<s>(.*?)</s>} $gl] {append w "$r "}
  668.                         if {![string is space $w]} {
  669.                             append t "\"$w0\"" " \"\037[string trim $w0]\037 ([join [split [string trim $w]] ", "]) \" "
  670.                         } {
  671.                             append t "\"$w0\"" " \"\037[string trim $w0]\037 \" "
  672.                         }
  673.                 }
  674.             }
  675.             lput putserv "\[$spt/Spell\] :: $ln[string map $t $ustr]" $prefix
  676.         } {lput putserv "\[Yandex/Spell\] :: ${ustr}" $prefix}
  677.  
  678.     } ;# Yspell / Gspell
  679.  
  680.     if {$type == 9} {
  681.         if {[regexp -- {"translatedText":"(.*?)"\}} $str -> t]} {lput putserv "\[Google/Trans\] :: $t" $prefix
  682.         } elseif {[regexp -- {"language":"(.*?)".*?"isReliable":(.*?),.*?"confidence":(.*?)\}} $str - l r c]} {
  683.             set glang {af Africaans sq Albanian am Amharic ar Arabic hy Armenian az Azerbaijani eu Basque be Belarusian bn Bengali bh Bihari bg Bulgarian my Burmese ca Catalan chr Cherokee zh Chinese zh-CN Chinese_simpl zh-TW Cninese_trad hr Croatian cs Czech da Danish dv Dhivehi nl Dutch en English eo Esperanto et Estonian tl Filipino fi Finnish fr French gl Galician ka Georgian de German el Greek gn Guarani gu Gujarati iw Hebrew hi Hindi hu Hungarian is Icelandic id Indonesian iu Inuktitut it Italian ja Japanese kn Kannada kk Kazakh km Khmer ko Korean ku Kurdish ky Kyrgyz lo Laothian lv Latvian lt Lithuanian mk Macedonian ms Malay ml Malayam mt Maltese mr Marathi mn Mongolian ne Nepali no Norwegian or Oriya ps Pashto fa Persian pl Polish pt-PT Portuguese pa Punjabi ro Romanian ru Russian sa Sanskrit sr Serbian sd Sindhi si Singhalese sk Slovak sl Slovenian es Spanish sw Swahili sv Swedish tg Tajik ta Tamil tl Tagalog te Telugu th Thai bo Tibetan tr Turkish uk Ukrainian ur Urdu uz Uzbek ug Uighur vi Vietnamese}
  684.             lput putserv "\[Google/Detect\] :: [list [string map $glang $l] :: ($r / $c)]" $prefix
  685.         } {lput putserv "\[Google/Trans\] :: \037Нет перевода\037." $prefix}
  686.     } ;# Google Translate / Detect
  687.  
  688.     return
  689.     }      
  690. #----------------------------------------------------------------------------
  691. ##---end-parser------
  692. #----------------------------------------------------------------------------
  693.  
  694.     proc sspace {strr} {return [string trim [regsub -all {[\t\s]+} $strr { }]]}
  695.     proc frmd {strr} {return [clock format [clock scan [string range $strr 0 9]] -format %d-%m-%Y]}
  696.     proc uenc {strr} {return [encoding convertto cp1251 [string map {\& "&amp;" \" "&quot;" < "&lt;" > "&gt;"} $strr]]}
  697.  
  698.     proc uencg {strr} {
  699.     set str "" ; foreach byte [split [encoding convertto utf-8 $strr] ""] {scan $byte %c i ; if {[string match {[%<>"]} $byte] || $i < 65 || $i > 122} {append str [format %%%02X $i]} {append str $byte}}
  700.     return [string map {%3A : %2D - %2E . %30 0 %31 1 %32 2 %33 3 %34 4 %35 5 %36 6 %37 7 %38 8 %39 9 \[ %5B \\ %5C \] %5D \^ %5E \_ %5F \` %60} $str]
  701.     }
  702.  
  703.     proc sconv {strr {mode {1}}} {
  704.     set escapes {
  705.         &nbsp; \x20 &quot; \x22 &amp; \x26 &apos; \x27 &ndash; \x2D
  706.         &lt; \x3C &gt; \x3E &tilde; \x7E &euro; \x80 &iexcl; \xA1
  707.         &cent; \xA2 &pound; \xA3 &curren; \xA4 &yen; \xA5 &brvbar; \xA6
  708.         &sect; \xA7 &uml; \xA8 &copy; \xA9 &ordf; \xAA &laquo; \xAB
  709.         &not; \xAC &shy; \xAD &reg; \xAE &hibar; \xAF &deg; \xB0
  710.         &plusmn; \xB1 &sup2; \xB2 &sup3; \xB3 &acute; \xB4 &micro; \xB5
  711.         &para; \xB6 &middot; \xB7 &cedil; \xB8 &sup1; \xB9 &ordm; \xBA
  712.         &raquo; \xBB &frac14; \xBC &frac12; \xBD &frac34; \xBE &iquest; \xBF
  713.         &Agrave; \xC0 &Aacute; \xC1 &Acirc; \xC2 &Atilde; \xC3 &Auml; \xC4
  714.         &Aring; \xC5 &AElig; \xC6 &Ccedil; \xC7 &Egrave; \xC8 &Eacute; \xC9
  715.         &Ecirc; \xCA &Euml; \xCB &Igrave; \xCC &Iacute; \xCD &Icirc; \xCE
  716.         &Iuml; \xCF &ETH; \xD0 &Ntilde; \xD1 &Ograve; \xD2 &Oacute; \xD3
  717.         &Ocirc; \xD4 &Otilde; \xD5 &Ouml; \xD6 &times; \xD7 &Oslash; \xD8
  718.         &Ugrave; \xD9 &Uacute; \xDA &Ucirc; \xDB &Uuml; \xDC &Yacute; \xDD
  719.         &THORN; \xDE &szlig; \xDF &agrave; \xE0 &aacute; \xE1 &acirc; \xE2
  720.         &atilde; \xE3 &auml; \xE4 &aring; \xE5 &aelig; \xE6 &ccedil; \xE7
  721.         &egrave; \xE8 &eacute; \xE9 &ecirc; \xEA &euml; \xEB &igrave; \xEC
  722.         &iacute; \xED &icirc; \xEE &iuml; \xEF &eth; \xF0 &ntilde; \xF1
  723.         &ograve; \xF2 &oacute; \xF3 &ocirc; \xF4 &otilde; \xF5 &ouml; \xF6
  724.         &divide; \xF7 &oslash; \xF8 &ugrave; \xF9 &uacute; \xFA &ucirc; \xFB
  725.         &uuml; \xFC &yacute; \xFD &thorn; \xFE &yuml; \xFF
  726.     }
  727.         if {$mode} {
  728.             set strr [string map {\[ \\\[ \] \\\] \( \\\( \) \\\) \{ \\\{ \} \\\} \\ \\\\} [string map $escapes [join [lrange [split $strr] 0 end]]]]
  729.             regsub -all -- {&#([[:digit:]]{1,5});} $strr {[format %c [string trimleft "\1" "0"]]} strr
  730.             regsub -all -- {&#x([[:xdigit:]]{1,4});} $strr {[format %c [scan "\1" %x]]} strr
  731.             regsub -all -- {&#?[[:alnum:]]{2,7};} $strr "" strr
  732.             return [subst -nov $strr]
  733.         } {return [string map $escapes $strr]}
  734.     }
  735.  
  736.     proc lput {cmd str {prefix {}} {maxchunk 420}} {
  737.     set buf1 "" ; set buf2 [list]
  738.     set ch [lindex $prefix 1]
  739.     if {[validchan $ch]} {if {([string first "c" [lindex [split [getchanmode $ch]] 0]] != -1) || ![channel get $ch usecolors]} {set str [stripcodes "c" $str]}}
  740.         foreach word [split $str] {append buf1 " " $word ; if {[string length $buf1]-1 >= $maxchunk} {lappend buf2 [string range $buf1 1 end]; set buf1 ""}}
  741.         if {$buf1 != ""} {lappend buf2 [string range $buf1 1 end]}
  742.     foreach line $buf2 {$cmd $prefix$line}
  743.     return
  744.     }
  745.  
  746.     proc queue_isfreefor {{ id {}}} {
  747.         variable reqqueue ; variable maxreqperuser ; variable maxrequests
  748.         variable laststamp ; variable pause
  749.         variable err_queue_full ; variable err_queue_id ; variable err_queue_time
  750.  
  751.         if {[info exists laststamp(stamp,$id)]} {set timewait [expr {$laststamp(stamp,$id) + $pause - [unixtime]}] ; if {$timewait > 0} {return [subst -nocommands $err_queue_time]}}
  752.         if {[llength [array names reqqueue -glob "*,$id"]] >= $maxreqperuser} {return $err_queue_id}
  753.         if {[llength [array names reqqueue]] >= $maxrequests} {return $err_queue_full}     
  754.     return
  755.     }
  756.  
  757.     proc queue_add {newurl id parser extra {redir 0}} {
  758.         variable reqqueue ; variable proxy ; variable timeout
  759.         variable laststamp ; variable query ; variable type
  760.  
  761.         ::http::config -proxyfilter "[namespace current]::queue_proxy"
  762.         if {$query eq ""} {
  763.             if {![catch {set token [::http::geturl $newurl -command [namespace current]::queue_done -binary true -timeout $timeout]} errid]} {                 
  764.             set reqqueue($token,$id) [list $parser $extra $redir] ; set laststamp(stamp,$id) [unixtime]
  765.             } {return false}
  766.         } {
  767.             if {![catch {set token [::http::geturl $newurl -command [namespace current]::queue_done -binary true -timeout $timeout -query ${query}]} errid]} {                 
  768.             set reqqueue($token,$id) [list $parser $extra $redir] ; set laststamp(stamp,$id) [unixtime]
  769.             } {return false}
  770.         }
  771.     return true
  772.     }
  773.  
  774.     proc queue_proxy {url} {
  775.         variable proxy
  776.         if {$proxy ne {}} {return [split $proxy {:}]}      
  777.     return [list]
  778.     }
  779.    
  780.     proc queue_done {token} {
  781.         upvar #0 ${token} state
  782.         variable reqqueue ; variable maxredir ; variable fetchurl
  783.  
  784.         set errid       [::http::status ${token}]
  785.         set errstr      [::http::error  ${token}]      
  786.         set id          [array  names reqqueue "$token,*"]
  787.         foreach {parser extra redir} $reqqueue($id) {break}
  788.         regsub -- "^$token," $id {} id
  789.    
  790.         while (1) {
  791.             if {$errid == "ok" && [::http::ncode $token] == 302} {
  792.                 if {$redir < $maxredir} {          
  793.                     array set meta $state(meta)
  794.                     if {[info exists meta(Location)]} {queue_add "$meta(Location)" $id $parser $extra [incr redir]; putlog "redir: $meta(Location)" ; break}
  795.                 } {set errid "error" ; set errstr "Max. redir."}
  796.             }
  797.            
  798.             if {[catch {$parser {errid} {errstr} {state(body)} {extra}} errid]} {lput putlog [string range $errid 0 50] "[namespace current] - "}
  799.         break
  800.         }          
  801.         array unset reqqueue "$token,*"
  802.         ::http::cleanup $token
  803.     return
  804.     }
  805.  
  806.     proc queue_clear_stamps {} {
  807.         variable laststamp ; variable timeout ; variable timerID
  808.  
  809.         set curr [expr {[unixtime] - 2 * $timeout / 1000}];
  810.         foreach {id} [array names laststamp] {if {$laststamp($id) < $curr} {array unset laststamp $id}}    
  811.         set timerID [timer 10 "[info level 0]"]
  812.     }
  813.  
  814.     proc cmdaliases {{action {bind}}} {
  815.         foreach {bindtype} {pub msg dcc} {
  816.             foreach {bindproc} [info vars "[namespace current]::${bindtype}:*"] {
  817.                 variable "${bindtype}prefix" ; variable "${bindtype}flag"          
  818.                 foreach {alias} [set $bindproc] {catch {$action $bindtype [set ${bindtype}flag] [set ${bindtype}prefix]$alias $bindproc}}              
  819.             }
  820.         }  
  821.     return
  822.     }
  823.  
  824. # json from tcllib
  825.     proc getc {{txtvar txt}} {
  826.     upvar 1 $txtvar txt
  827.     if {$txt eq ""} {return -code error "unexpected end of text"}
  828.     set c [string index $txt 0] ; set txt [string range $txt 1 end]
  829.     return $c
  830.     }
  831.  
  832.     proc json2dict {txt} {return [_json2dict]}
  833.  
  834.     proc _json2dict {{txtvar txt}} {
  835.     upvar 1 $txtvar txt
  836.  
  837.     set state TOP
  838.  
  839.     set txt [string trimleft $txt]
  840.     while {$txt ne ""} {
  841.         set c [string index $txt 0]
  842.         while {[string is space $c]} {getc ; set c [string index $txt 0]}
  843.  
  844.     if {$c eq "\{"} {
  845.         switch -- $state {
  846.         TOP {getc ; set state OBJECT ; set dictVal [dict create]}
  847.         VALUE {dict set dictVal $name [_json2dict] ; set state COMMA}
  848.         LIST {lappend listVal [_json2dict] ; set state COMMA}
  849.         default {return -code error "unexpected open brace in $state mode"}
  850.         }
  851.     } elseif {$c eq "\}"} {
  852.         getc ; if {$state ne "OBJECT" && $state ne "COMMA"} {return -code error "unexpected close brace in $state mode"} ; return $dictVal
  853.     } elseif {$c eq ":"} {
  854.         getc ; if {$state eq "COLON"} {set state VALUE} {return -code error "unexpected colon in $state mode"}
  855.     } elseif {$c eq ","} {
  856.         if {$state eq "COMMA"} {
  857.         getc
  858.         if {[info exists listVal]} {
  859.             set state LIST
  860.         } elseif {[info exists dictVal]} {
  861.             set state OBJECT
  862.         }
  863.         } else {
  864.         return -code error "unexpected comma in $state mode"
  865.         }
  866.     } elseif {$c eq "\""} {
  867.         set reStr {(?:(?:\")(?:[^\\\"]*(?:\\.[^\\\"]*)*)(?:\"))}
  868.         set string ""
  869.         if {![regexp $reStr $txt string]} {
  870.         set txt [string replace $txt 32 end ...]
  871.         return -code error "invalid formatted string in $txt"
  872.         }
  873.         set txt [string range $txt [string length $string] end]
  874.         set string [subst -nocommand -novariable \
  875.                 [string range $string 1 end-1]]
  876.  
  877.         switch -- $state {
  878.         TOP {return $string}
  879.         OBJECT {set name $string ; set state COLON}
  880.         LIST {lappend listVal $string ; set state COMMA}
  881.         VALUE {dict set dictVal $name $string ; unset name ; set state COMMA}
  882.         }
  883.     } elseif {$c eq "\["} {
  884.         switch -- $state {
  885.         TOP {getc ; set state LIST}
  886.         LIST {lappend listVal [_json2dict] ; set state COMMA}
  887.         VALUE {dict set dictVal $name [_json2dict] ; set state COMMA}
  888.         default {return -code error "unexpected open bracket in $state mode"}
  889.         }
  890.     } elseif {$c eq "\]"} {
  891.         getc ; if {![info exists listVal]} {return ""}
  892.         return $listVal
  893.     } elseif {0 && $c eq "/"} {
  894.         getc ; set c [getc]
  895.         switch -- $c {
  896.         / {
  897.             # // comment form
  898.             set i [string first "\n" $txt]
  899.             if {$i == -1} {
  900.             set txt ""
  901.             } else {
  902.             set txt [string range $txt [incr i] end]
  903.             }
  904.         }
  905.         * {
  906.             # /* comment */ form
  907.             getc
  908.             set i [string first "*/" $txt]
  909.             if {$i == -1} {
  910.             return -code error "incomplete /* comment"
  911.             } else {
  912.             set txt [string range $txt [incr i] end]
  913.             }
  914.         }
  915.         default {
  916.             return -code error "unexpected slash in $state mode"
  917.         }
  918.         }
  919.     } elseif {[string match {[-0-9]} $c]} {
  920.         string is double -failindex last $txt
  921.         if {$last > 0} {
  922.         set num [string range $txt 0 [expr {$last - 1}]]
  923.         set txt [string range $txt $last end]
  924.  
  925.         switch -- $state {
  926.             TOP {return $num}
  927.             LIST {lappend listVal $num ; set state COMMA}
  928.             VALUE {dict set dictVal $name $num ; set state COMMA}
  929.             default {getc ; return -code error "unexpected number '$c' in $state mode"}
  930.         }
  931.         } {getc ; return -code error "unexpected '$c' in $state mode"}
  932.     } elseif {[string match {[ftn]} $c]
  933.           && [regexp {^(true|false|null)} $txt val]} {
  934.         set txt [string range $txt [string length $val] end]
  935.  
  936.         switch -- $state {
  937.         TOP {return $val}
  938.         LIST {lappend listVal $val ; set state COMMA}
  939.         VALUE {dict set dictVal $name $val ; set state COMMA}
  940.         default {getc ; return -code error "unexpected '$c' in $state mode"}
  941.         }
  942.     } else {
  943.         return -code error "unexpected '$c' in $state mode"
  944.     }
  945.    }
  946.     } ;#json
  947.  
  948. #---init
  949.     if {[info exists timerID]} {catch {killtimer $timerID} ; catch {unset timerID}}
  950.     [namespace current]::queue_clear_stamps
  951.     foreach bind [binds "[namespace current]::*"] {catch {unbind [lindex $bind 0] [lindex $bind 1] [lindex $bind 2] [lindex $bind 4]}}
  952.     if {[catch {source [string map {.tcl .set} [info script]] ; set cfig "external"}]} {set cfig "internal"}
  953.     [namespace current]::cmdaliases
  954.     putlog "[namespace current] v$version [expr {[info exists ::sp_version]?"(suzi_$::sp_version)":""}] :: file:[lindex [split [info script] "/"] end] / rel:\[$date\] / mod:\[[clock format [file mtime [info script]] -format "%d-%b-%Y : %H:%M:%S"]\] :: config: $cfig :: by $author :: loaded."
  955.  
  956. } ;#end searcher
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!