From 6bb1f4f83a096a63055ec5b7d939fdb137a15997 Mon Sep 17 00:00:00 2001 From: Roman Zaharov Date: Wed, 10 Nov 2010 15:04:34 +1000 Subject: [PATCH] Noweb literate program is done. --- src/leica.nw | 1183 +++++++++++++++++++++++++++++++------------------- 1 file changed, 742 insertions(+), 441 deletions(-) diff --git a/src/leica.nw b/src/leica.nw index 59d9f4a..8613415 100644 --- a/src/leica.nw +++ b/src/leica.nw @@ -13,167 +13,126 @@ \begin{document} \pagestyle{noweb} -@ \paragraph{Введение.} Год назад, после недолгого изучения Python и -Common Lisp, я взялся за Clojure. Примерно в то же время я открыл для -себя местный файлообменный сайт, ныне опустившийся до непотребного в -плане рекламы состояния, но все еще приносящий пользу, благо на нем -обитает немало народу со всего дальнего востока. На этом сайте любой -желающий может опубликовать свое сообщение~--- набор из картинок, -текста описания и ссылок на залитые на файлообменник файлы. Часто -среди опубликованного на сайте попадается действительно стоящий -контент. И в большинстве случаев это вовсе не один файл, а добрая -пачка на несколько гигабайт. Естественно, ставить закачки в очередь -ручками и караулить не сломалось ли чего по ходу дела~--- не мой -метод. И конечно же, закачек должно быть много и идти они должны -одновременно. - -Ubuntu~--- моя домашняя система. В сообществе файлообменника есть +@ \section{Введение} + +Год назад, после недолгого изучения Python и Common Lisp я взялся за +Clojure. Примерно в то же время я открыл для себя местный +файлообменный сайт, ныне опустившийся до непотребного в плане рекламы +состояния, но все еще приносящий пользу, благо на нем обитает немало +народу со всего дальнего востока. На этом сайте любой желающий может +опубликовать свое сообщение~— набор из картинок, текста описания и +ссылок на залитые на файлообменник файлы. Часто среди опубликованного +попадаются действительно стоящие вещи. И в большинстве случаев это +добрая пачка ссылок на файлы общим весом в несколько +гигабайт. Естественно, качать ручками из браузера и караулить не +сломалось ли чего по ходу дела~— не мой метод. + +Ubuntu~— моя домашняя система. В сообществе файлообменника есть программирующие люди, но они ориентируются в основном на пользователей -Windows (на то есть веская причина~--- согласно статистике, процент -пользователей Linux~--- это 1 процент от всех -пользователей). Соответственно, под линукс программ нет (точнее, есть -скрипты некоторых пользователей, но они страшны как смертный грех), а -тот один единственный достойный менеджер закачек и по совместительству -плугин Фаерфокса (которым я не пользуюсь с тех пор как появился Хром) -слишком «общий» и не достаточно хорошо заточен под этот сайт. - -Я взялся написать качалку. Сперва попробовал написать её на Common -Lisp~--- не получилось (я плохо его знал). Потом я попробовал -написать её на Python. Получилось. Но программа была многопоточная, -а питон и многопоточность~--- вещи не лучшим образом подходящие друг -другу. Внутренняя структура походила на многоэтажное здание, +Windows. На то есть веская причина, ведь согласно статистике линуксом +пользуется всего один процент пользователей (согласно опросу). И это +естественно, что под линукс программ нет. Точнее есть~— скрипты +некоторых пользователей, но они страшны как смертный грех. А тот один +единственный достойный менеджер закачек и по совместительству плугин +Фаерфокса (которым я не пользуюсь с тех пор как появился Хром) слишком +«общий» и не достаточно хорошо заточен под местный сайт. + +Я взялся написать качалку. Сперва пробовал написать её на Common Lisp, +но у меня не получилось~— я слишком плохо его знал. Потом попробовал +написать её на Python. Получилось. Но программа была многопоточная, а +питон и многопоточность~— вещи не лучшим образом подходящие друг +другу. Структура программы походила на многоэтажное здание, построенное из костылей. Я бросил Python и взялся переписать программу на Clojure. Получилось не с первого раза, но процесс и результат меня порадовали: при всей многопоточности работа с состоянием так же проста, как в обычных, -однопоточных императивных программах~--- происходит практически «не - задумываясь», одним словом Clojure~--- отличный выбор для +однопоточных императивных программах~— происходит практически «не + задумываясь», одним словом Clojure~— отличный выбор для многопоточных сетевых приложений. -Если быть чуть более честным, то эта конечная версия «Лейки», которую -я здесь описываю является плодом многократных переписываний и -всевозможных экспериментов над кодом, стилем и подходом к написанию -программ на Clojure. Эту программу я переписывал около семи раз в -течение года. Усилия, что я приложил к этому~--- хорошая цена за -полученный мною опыт. В результате каждой такой переписи я осваивал -тот или иной прием программирования. И изложенная ниже финальная -версия программы представляет собой предельно идиоматичный Clojure-код -который я сейчас способен написать. - -Далее я расскажу как написать приложение на Clojure на -примере моей качалки. - -@ \paragraph{Дизайн конкурентной программы.} В отличие от простых, -последовательных программ, работающих в одном потоке, сконструировать -конкурентную программу куда сложнее~--- из-за большого количества -потенциальных взаимодействий между её частями, работающих в разных -потоках (что, собственно и является смыслом слова «конкурентный»). Но -если следовать следующим простым правилам, задача сильно упрощается. - -\begin{enumerate} -\item \emph{Неформальная спецификация}. Первым делом нужно - определить~--- что же программа должна делать? - -\item \emph{Компоненты.} Необходимо перечислить все формы конкурентной - активности~--- каждая из них становится компонентом (например, - агентом). Далее следует нарисовать блочную диаграмму системы, в - которой будут показаны все экземпляры компонентов. - -\item \emph{Протокол сообщений.} Решить какие сообщения будут посылать - компоненты и спроектировать протоколы соообщений между - ними. Нарисовать диаграмму компонентов со всеми протоколами - сообщений. - -\item \emph{Диаграммы состояний.} Для каждого конкурентного компонента - нужно нарисовать диаграмму состояний и проверить, что в каждом - состоянии компонент получает и посылает правильные сообщения и - выполняет правильные действия. - -\item \emph{Закодировать и распланировать.} Закодировать систему на - любимом языке программирования и выбрать любимый алгоритм - планирования взаимодействий между компонентами. - -\item \emph{Протестировать и повторять} до тех пор пока программа не - станет работать так как от нее ожидается. -\end{enumerate} - -@ \paragraph{Неформальная спецификация.} У нас есть текстовый файл -наполненный ссылками на страницы разнообразных файлообменных ресурсов -или ссылками непосредственно на файлы на этих ресурсах. Нам нужно -скачать эти файлы с файлообменников, причем их можно качать в -несколько потоков, в зависимости от возможностей, предоставляемых -конкретными сервисами. По ходу скачивания могут возникнуть -проблемы~--- на файлообменнике может не оказаться файла, загрузка -может оборваться, на диске может быть недостаточно места~--- при -обрыве загрузка должна возобновляться, если это возможно. Программа -консольная и будет работать в пакетном режиме, при этом во время её -работы в консоли будет отображаться полоса прогресса загрузки. - -Но прежде чем перейти к деталям реализации я сделаю большое -отступление и расскажу о тонкостях работы с состоянием в Clojure. - -@ \paragraph{Работа с состоянием в Clojure.} Clojure~--- особенный -императивный язык. В отличие от подавляющего большинства языков -программирования, в которых есть только один способ работы с -состоянием~--- старые добрые переменные, в Clojure их как минимум четыре, -из-за специфичного подхода \emph{программной транзакционной памяти} -(\emph{software transactional memory, STM}). - -Подход к состоянию в Clojure довольно прост~--- он основывается на +Если быть чуть более честным, то версия «Лейки», которую я здесь +описываю является плодом многократных переписываний и всевозможных +экспериментов над кодом, стилем и подходом к написанию программ на +Clojure. Эту программу я переписывал около семи раз в течение +года. Усилия, что я приложил к этому~— хорошая цена за полученный +мною опыт. В результате каждой такой переписи я осваивал тот или иной +прием программирования. И изложенная ниже финальная версия программы +представляет собой предельно идиоматичный Clojure-код который я сейчас +способен написать. + +В этой статье целиком и полностью, в стиле «литературного + программирования», описана моя маленькая программа, многопоточный +консольный менеджер закачек «Лейка». Я пользуюсь этой программой уже +очень давно и скачал ею не одну сотню гигабайт, так что я надеюсь, эта +программа послужит читателю если и не для практических целей, то +хотябы для учебных. Но прежде чем перейти к деталям реализации я +сделаю большое отступление и расскажу о тонкостях работы с состоянием +в Clojure. + +@ \section{Работа с состоянием в Clojure} + +Clojure~— особенный императивный язык. В отличие от подавляющего +большинства языков программирования, в которых есть только один способ +работы с состоянием~— старые добрые переменные, в Clojure их как +минимум четыре, из-за специфичного подхода \emph{программной + транзакционной памяти} (\emph{software transactional memory, STM}). + +Подход к состоянию в Clojure довольно прост~— он основывается на четком разграничении \emph{значения}, \emph{состояния} и \emph{идентичности}, которые во многих языках объединены в одну сущность. \begin{description} \item[Значение (\emph{value})] Нечто неизменяемое, или совокупность - неизменяемых величин. Например число 3~--- оно, как говорится, и в - Африке 3~--- в математическом, вневременном смысле; все тройки + неизменяемых величин. Например число 3~— оно, как говорится, и в + Африке 3~— в математическом, вневременном смысле; все тройки одинаковы, в том смысле, что существует только \emph{одна} «тройка». \item[Идентичность (\emph{identity})] Сущность, которую мы ассоциируем с последовательностью состояний во времени. Даже если 2 идентичности - имеют одинаковое значение (или одно и то же значение~--- тут никакой + имеют одинаковое значение (или одно и то же значение~— тут никакой разницы), они не будут равны друг другу. -\item[Состояние (\emph{value})] Значение идентичности в некоторый +\item[Состояние (\emph{state})] Значение идентичности в некоторый момент времени. \end{description} Идентичностями (т.е. изменяемыми объектами) в Clojure являются \emph{переменные} (\emph{variables}) и \emph{ссылки} -(\emph{references}), всего их 4 вида, у каждый вид используется для +(\emph{references}), всего их 4 вида; каждый вид используется для своих целей. \begin{description} \item[Переменные (\emph{variables})] могут изменяться только внутри одного единственного потока, поэтому они используются как глобальные - переменные~--- к ним привязываются функции, макросы и просто + переменные~— к ним привязываются функции, макросы и просто значения; из-за динамической привязки отлично подходят для разного рода аспектно-ориентированного программирования. \item[Атомы (\emph{atoms})] это переменные, доступные для чтения и изменения из всех потоков; изменяются атомарно, по-отдельности, - кажлый атом в своей транзакции. Ипользуются как старые добрые + каждый атом в своей транзакции. Ипользуются как старые добрые переменные в обычных языках. -\item[Ссылки (\emph{references})] — как атомы, только изменяются внутри явно - обозначенной программистом транзакции, поэтому используются для +\item[Ссылки (\emph{references})] как атомы, только изменяются внутри + явно обозначенной программистом транзакции, поэтому используются для одновременного координированного группового изменения. -\item[Агенты (\emph{agents})] — переменные, доступные изо всех +\item[Агенты (\emph{agents})] это переменные, доступные изо всех потоков, для изменения которых нужно отправить им \emph{сообщение}, состоящее из функции с аргументами. После отправки сообщения агенту - программа продолжает свою работу; изменение агента (вычисление - функции сообщения) происходит в отдельном потоке, после чего агент - принимает значение результата вычисления сообщения. Агенту можно - послать сразу несколько сообщений, они сохранятся в очереди - сообщений и будут обработаны последовательно. До тех пор, пока не - будет вычислено сообщение, агент сохраняет свое прежнее значение. + программа продолжает свою работу; изменение состояния агента + (вычисление функции сообщения) происходит в отдельном потоке, после + чего агент принимает значение результата вычисления + сообщения. Агенту можно послать сразу несколько сообщений, они + сохранятся в очереди сообщений и будут обработаны + последовательно. До тех пор, пока не будет вычислено сообщение, + агент сохраняет свое прежнее значение. \end{description} -Агенты~--- ключевые компоненты в этой программе, поэтому о них стоит +Агенты~— ключевые компоненты в этой программе, поэтому о них стоит рассказать подробнее. Стиль программирования агентов Clojure в миру зовется @@ -183,11 +142,17 @@ Lisp~--- не получилось (я плохо его знал). Потом Агенты используются как основные «рабочие лошадки». В отличие от ссылок и атомов, изменять которые можно только «чистыми» функциями -(точнее, очень рекомендуется~--- из-за отката и повтора транзакций -побочные эффекты могут причинить неприятности) сообщения агентов, как -правило~--- функции с побочными эффектами. +(точнее, очень рекомендуется~— из-за отката и повтора транзакций +побочные эффекты могут причинить неприятности); сообщения агентов, как +правило~— функции с побочными эффектами. + +В статье местами я использую терминологию слегка нетипичную для +Clojure, например {\emдействие агента}~— это то же самое, что и +функция-сообщение которое можно отправить агенту. {\emТело агента}~— +то же самое что и состояние агента. {\emВыполнение действия}~— +обработка сообщения. -Агенту можно отправить сообщение двумя способами. Первый~--- для +Агенту можно отправить сообщение двумя способами. Первый~— для «быстрых» или процессороёмких, обычно без побочных эффектов, сообщений. Такие сообщения будут выполняться на ограниченном, в зависимости от количества ядер процессора, количестве потоков: @@ -204,7 +169,7 @@ Lisp~--- не получилось (я плохо его знал). Потом (send-off agent function args) \end{verbatim} -Состояние агента можно узнать в любое время~--- для этого не надо +Состояние агента можно узнать в любое время~— для этого не надо ждать окончания обработки отправленного ему сообщения: \begin{verbatim} @@ -213,38 +178,203 @@ Lisp~--- не получилось (я плохо его знал). Потом @agent \end{verbatim} -Если во время обработки сообщения возникает ошибка (исключение)~--- -она сохраняется в агенте, ошибки агента можно увидеть вызвав функциию -[[agent-errors]]. При этом агент становится недоступным для сообщений -до тех пор, пока не будет очищен от ошибок функцией -[[clear-agent-errors]]. +Если во время обработки сообщения возникает ошибка, т.е. выбрасывается +исключение~— оно сохраняется в агенте; ошибки агента можно увидеть +вызвав функциию [[agent-errors]]. При этом агент становится +недоступным для сообщений до тех пор, пока не будет очищен от ошибок +функцией [[clear-agent-errors]]. + +Во время обработки агентом сообщения внутри функции-сообщения +становится доступной переменная [[*agent*]], значением которой +является агент, который обрабатывает сообщение. Таким образом агент +может посылать сообщения самому себе. Также, не-нилевое значение +переменной [[*agent*]] является признаком того, что код выполняется +внутри действия агента. + +Все сообщения которые агент отсылает себе или другим агентам во время +выполнения действия задерживаются до окончания действия, что +доставляет неудобства, так как в большинстве случаев бывает необходима +мгновенная отправка. В подобных случаях используется функция +[[release-pending-sends]]. + +@ \section{Дизайн конкурентной программы} + +В отличие от простых, последовательных программ, работающих в одном +потоке, сконструировать конкурентную программу куда сложнее~— из-за +большого количества потенциальных взаимодействий между её частями, +работающих в разных потоках (что, собственно и является смыслом слова +«конкурентный»). Но если следовать следующим простым правилам, +описанным в 5 главе «Message-Passing Concurrency» книги «Concepts, + Techniques, and Models of Computer Programming» задача сильно +упрощается. + +\begin{enumerate} +\item \emph{Неформальная спецификация}. Первым делом нужно + определить~— что же программа должна делать? + +\item \emph{Компоненты.} Необходимо перечислить все формы конкурентной + активности~— каждая из них становится компонентом (например, + агентом). Далее следует нарисовать блочную диаграмму системы, в + которой будут показаны все экземпляры компонентов. + +\item \emph{Протокол сообщений.} Решить какие сообщения будут посылать + компоненты и спроектировать протоколы соообщений между + ними. Нарисовать диаграмму компонентов со всеми протоколами + сообщений. + +\item \emph{Диаграммы состояний.} Для каждого конкурентного компонента + нужно нарисовать диаграмму состояний и проверить, что в каждом + состоянии компонент получает и посылает правильные сообщения и + выполняет правильные действия. + +\item \emph{Закодировать и распланировать.} Закодировать систему на + любимом языке программирования и выбрать любимый алгоритм + планирования взаимодействий между компонентами. + +\item \emph{Протестировать и повторять} до тех пор пока программа не + станет работать так как от нее ожидается. +\end{enumerate} + +В общих чертах я следовал этой схеме, но картинок в статье я приводить +не стану. В них нет особой надобности. + +@ \section{Неформальная спецификация} + +У нас есть текстовый файл наполненный ссылками на страницы +разнообразных файлообменных ресурсов или прямыми ссылками +непосредственно на файлы на этих ресурсах. Нам нужно скачать эти файлы +с файлообменников, причем их можно качать в несколько потоков, в +зависимости от возможностей, предоставляемых конкретными сервисами. По +ходу скачивания могут возникнуть проблемы~— на файлообменнике может +не оказаться файла, загрузка может оборваться, на диске может быть +недостаточно места. При обрыве связи загрузка должна возобновляться, если +это возможно. Программа консольная и будет работать в пакетном режиме, +при этом во время её работы в консоли будет отображаться полоса +прогресса загрузки. + +Скомпилированная в Jar программа будет запускаться так: + +\begin{verbatim} + java -jar leica.jar путь-к-файлу-с-ссылками [директория-куда-качать] +\end{verbatim} -% TODO: *agent* +В командной строке указывается путь к файлу с ссылками и, +необязательно, директория в которую будут скачиваться файлы. Эту +информацию мы отразим в небольшой подсказке, которая будет выдаваться +при запуске программы с ключом \texttt{--help}. -@ \paragraph{Компоненты.} В программе будет три взаимодействующих -компонента, каждый из которых представляет свой тип конкурентной -активности~--- многочисленные \emph{загрузки}, \emph{планировщик - загрузок} и \emph{монитор прогресса} загрузок. Все эти компоненты -представлены агентами Clojure и работают одновременно, координируя -свои действия между собой. +<>= +"Leica -- downloader written in lisp. + +Run: + +java -jar leica.jar [keys] [file with links] [directory]" +@ + +@ \section{Структура программы} + +Почти вся программа находится в одном файле. В этой статье описывается +файл {\ttfamily leica.clj}. В репозитории есть еще один файл с модулем +самодельного логгера {\ttfamily log.clj}. Признаюсь, мне не хватило +терпения осилить ни один из трех монструозных джавовских логгеров, +поэтому я написал свой собственный. + +Clojure~— язык настолько же функциональный, насколько и +императивный, поэтому перед использованием имени в программе оно +обязательно должно быть определено. Это ведет к тому, что программы на +Clojure пишутся снизу-вверх. В этой статье я излагаю программу для +лучшего её восприятия читателем, а не компьютером~— и так и этак, я +прыгаю с одного уровня на другой, перемешивая восходящий и нисходящий +порядок изложения кода. + +Вот вся программа, как она видна «с высоты птичьего полета». Программа +разбита на несколько основных секций: сперва определяется пространство +имен в котором находится весь этот код, затем все встречающиеся в +программе имена, диспетчеры мультиметодов, мультиметоды, в блоке +{\ttfamily definitions} определяются значения всех имен, в самом конце +определена главная процедура [[-main]]. + +<>= +;;; -*- mode: clojure; coding: utf-8 -*- + +;; Copyright (C) 2010 Roman Zaharov + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +<> +(declare <>) +<> +<> +<> +<> +<
> +@ + +@ В определении пространства имен указываются все используемые в коде +модули и имена из них. + +<>= +(ns leica + (:gen-class) + (:use + [log :only [info debug error]] + [clojure.set :only [difference union]] + [clojure.contrib.duck-streams :only [slurp* read-lines]] + clojure.contrib.command-line + clojure.contrib.def + clojure.test + hooks) + + (:require + [clojure.contrib.io :as io]) + + (:import + (java.util Date) + (java.net URLDecoder + ConnectException) + (java.io File + FileOutputStream + InputStream) + (org.apache.commons.httpclient URI + HttpClient + HttpStatus + ConnectTimeoutException + NoHttpResponseException + methods.GetMethod + methods.HeadMethod + params.HttpMethodParams + util.EncodingUtil))) +@ %def leica + +@ \section{Компоненты} + +В программе будет три взаимодействующих компонента, каждый из которых +представляет собой некоторый вид конкурентной активности~— +многочисленные \emph{загрузки}, \emph{планировщик загрузок} и +\emph{монитор прогресса} загрузок. Все эти компоненты представлены +агентами Clojure и работают одновременно, координируя свои действия +между собой. \emph{Загрузки} это основные работники в этой программе. Эти агенты управляют всем процессом загрузки файла, начиная от получения ссылки со страницы с файлообменника и заканчивая собственно скачиванием -файла. Загрузки могут быть высокоуровневыми и по ходу своей работы они -могут создавать и управлять более низкоуровневыми загрузками. Загрузки +файла. Загрузки могут быть высокоуровневыми и по ходу своей работы +создавать и управлять более низкоуровневыми загрузками. Загрузки создаются конструктором [[make-download]]. Все наличествующие в -программе загрузки хранятся в глобальной переменной [[downloads*]]~--- -это ссылка на множество загрузок. +программе загрузки хранятся в глобальной переменной [[downloads*]]~— +это ссылка на множество всех загрузок. Загрузки автономны, каждая из них имеет собственную программу и сама управляет своими действиями, поэтому внешний интерфейс к ним весьма -прост; единственное, что можно сделать с загрузкой~--- отправить ей -сообщение запуска [[run]] и загрузка, в зависимости от ситуации в -которой она находится, выполнит действие предписанное ей её программой. +прост; единственное, что можно сделать с загрузкой~— отправить ей +сообщение запуска [[run]] и тогда загрузка, в зависимости от ситуации +в которой она находится, выполнит действие предписанное ей её +программой. \emph{Планировщик загрузок} это агент который координирует совместную -работу загрузок друг с другом: он составляет планы, запускает загрузки +работу загрузок друг с другом: он составляет план, запускает загрузки и следит за тем чтобы между ними не возникали конфликты из-за ресурсов. Планировщик представлен глобальной переменной [[download-scheduler*]]. @@ -253,7 +383,11 @@ Lisp~--- не получилось (я плохо его знал). Потом внутреннего состояния~— он работает с глобальным состоянием всей программы). Ему можно послать сообщение [[schedule-downloads]] в ходе обработки которого он определит загрузки которые нужно запустить, а -затем пошлет им сообщение запуска [[run]]. +затем пошлет им сообщение запуска [[run]] и сообщение, предписывающее +запустить планировщик после завершения выполнения действия +загрузкой. Тем самым планировщик и загрузки попеременно запускают друг +друга~— этот цикл сообщений и является основным механизмом +программы; когда он завершается~— завершается и работа программы. \emph{Монитор прогресса} это агент который отвечает за отображение информации о работе программы. Он отрисовывает полосу прогресса в @@ -261,15 +395,133 @@ Lisp~--- не получилось (я плохо его знал). Потом [[progress-monitor*]]. Монитор принимает сообщения от загрузок о начале слежения за -прогрессом загрузки [[begin-monitor-progress]], об обновлении +прогрессом загрузки [[begin-monitor-progress]], об отрисовке в консоли прогресса загрузки [[update-progress]] и о прекращении слежения за прогрессом загрузки [[cease-monitor-progress]]. -@ \paragraph{Загрузка.} Загрузка (\emph{downloads}) является агентом и -создается из соответствующего прототипа загрузки с помощью -конструктора [[make-download]] из строки \texttt{line} содержащей -ссылку на файлообменный ресурс. Конструктор [[make-download]] в -качестве опциональных ключей принимает \emph{программу загрузки} +@ \subsection{Главная процедура} + +Главная процедура обрабатывает аргументы командной строки. Выбирается +читабельный файл и из него считываются строки. Выбирается директория в +которую есть доступ на запись. Если в наличии нет файла или +директории~— программ завершается функцией [[exit-program]]. Затем +из ссылок в считанных из файла строках создаются загрузки и +запускается планировщик загрузок, который завершает работу программы +по окончании планирования. + +<
>= +(defn -main [& args] +(with-command-line args + <> + [remaining-args] + + (let [lines-with-links + (read-lines (some #(as-file % :readable true :directory false) remaining-args)) + + workpath + (or (some #(as-file % :writeable true :directory true) remaining-args) + (as-file (System/getProperty "user.dir") :writeable true :directory true))] + + (when-not lines-with-links + (info "You must specify file with links to download.") + (exit-program)) + + (when-not workpath + (info "You must specify directory in which files will be downloaded.") + (exit-program)) + + (doseq [line lines-with-links] + (make-download line :path workpath)) + + (send-off download-scheduler* assoc :when-done exit-program) + (send-off download-scheduler* schedule-downloads)))) +@ %def -main + +<>= +exit-program +@ + +<>= +(defn exit-program [] + (debug "Leica is done. Bye.") + (System/exit 0)) +@ %def exit-program + +@ Функция [[as-file]] это своеобразный швейцарский нож для работы с +файлами который я использую в основном для выяснения, существует ли +некий файл с определенными характеристиками. Например +\texttt{(as-file path :directory true :writeable true)} возвращает файл +\texttt{path} если это файл директории доступной для записи, в противном +случае он возвращает [[nil]]. + +Функция написана в «maybe-монадообразном стиле» характерном для кода +на Хаскелле~— аргумент с помощью макроса-комбинатора прогоняется +через множество maybe-функций, и если на некотором шаге одна из +функций возвращает [[nil]], то и в конце возвращается [[nil]]. + +<>= +as-file +@ + +<>= +(defn as-file + [arg & {:as args :keys [exists create readable writeable directory]}] + (let [argtype (type arg) + maybe-create + (fn [f] + (when f + (cond (and (= create true) (not (.exists f))) + (let [dir (File. (.getParent f))] + (if-not (.exists dir) + (throw (new Exception + "Cannot create file in nonexistant directory.")) + (if-not (.canWrite dir) + (throw (new Exception + "Cannot create file in nonwriteable directory.")) + (do (.createNewFile f) f)))) + :else f))) + maybe-exists + (fn [f] + (when f + (cond (= exists true) (when (.exists f) f) + (= exists false) (when-not (.exists f) f) + (not exists) f))) + maybe-directory + (fn [f] + (when f + (cond (= directory true) (when (.isDirectory f) f) + (= directory false) (when-not (.isDirectory f) f) + (not directory) f))) + maybe-readable + (fn [f] + (when f + (cond (= readable true) (when (.canRead f) f) + (= readable false) (when-not (.canRead f) f) + (not readable) f))) + maybe-writeable + (fn [f] + (when f + (cond (= writeable true) (when (.canWrite f) f) + (= writeable false) (when-not (.canWrite f) f) + (not writeable) f)))] + + (cond (= argtype File) + (-> arg maybe-create maybe-exists maybe-directory maybe-readable maybe-writeable) + + (= argtype String) + (if args + (apply as-file (new File arg) (flatten (seq args))) + (as-file (new File arg)))))) +@ %def as-file + + +@ \section{Загрузка} + +{\emЗагрузка} (\emph{download}) является агентом и создается из +соответствующего прототипа загрузки с помощью конструктора +[[make-download]] из строки \texttt{line} содержащей ссылку на +файлообменный ресурс. Конструктор [[make-download]] в качестве +опциональных ключей принимает \emph{программу загрузки} {\ttfamily:program}, каталог в который должны скачиваться файлы {\ttfamily:path} и имя загрузки {\ttfamily:name}. Каждой новой загрузке автоматически присваивается её порядковый номер @@ -280,7 +532,7 @@ Lisp~--- не получилось (я плохо его знал). Потом {\emТело загрузки} является хэшем (здесь и далее термин «хэш» обозначает базовую для Clojure структуру данных \emph{hash-map}) который представляет текущее состояние агента загрузки. Разные -загрузки создаются из разных прототипов и с разными телами~--- в +загрузки создаются из разных прототипов и с разными телами~— в зависимости от того какие функции они выполняют. {\emТип загрузки} это метка хранящаяся в ключе \texttt{:type} @@ -291,25 +543,27 @@ Lisp~--- не получилось (я плохо его знал). Потом {\emПрограмма загрузки} это функция, которая определяет каждое следующее \emph{действие} загрузочного агента, она полностью контролирует его поведение; на вход она принимает \emph{тело - загрузки}, на выходе выдает функцию-действие, которое должен + загрузки}, на выходе выдает функцию-действие, которую должен выполнить загрузочный агент. {\emДействие} загрузочного агента это функция которая применяется к телу агента, она выполняет некоторую полезную работу и изменяет -состояние агента. Возникающие во время выполнения действия ошибки, -непредусмотренные или возникающие по воле программиста, должны -приводить к выбрасыванию исключения. +состояние агента. + +Возникающие во время выполнения действия ошибки, непредусмотренные или +возникающие по воле программиста, должны приводить к выбрасыванию +исключения. Большинство загрузочных агентов содержат следующие ключи в своих телах: \begin{description} -\item[:link] это самая важная часть загрузочного агента~--- ссылка +\item[:link] это самая важная часть загрузочного агента~— ссылка которую загрузка будет обрабатывать и ради обработки которой она - создавалась. Например, загрузки, которые обрабатывают прямые ссылки + создавалась. Например загрузки которые обрабатывают прямые ссылки на файл просто загружают этот файл, в процессе следя за тем, чтобы не кончилось место на диске или не было дубликатов. Или если загрузка создана для обработки ссылок на пользовательские страницы - файлообменника, то она как правило, занимается тем, что вырезает + файлообменника, то она как правило занимается тем, что вырезает прямые ссылки из страницы, а затем создает и запускает новые загрузки для каждой прямой ссылки. @@ -325,7 +579,7 @@ Lisp~--- не получилось (я плохо его знал). Потом \item[:path] это директория в которую загружаются файлы. -\item[:program]~--- программа загрузочного агента. +\item[:program] это программа загрузочного агента. \item[:precedence] это порядковый номер загрузки. @@ -340,7 +594,7 @@ Lisp~--- не получилось (я плохо его знал). Потом \item[:fail-reason] это причина провала действия агента; содержит исключение которое было брошено во время выполнения последнего - действия. Селектор~--- [[fail-reason]]. Сбрасывается на [[nil]] + действия. Селектор~— [[fail-reason]]. Сбрасывается на [[nil]] после каждого удачного действия. \item[:run-atom] принимает истинное значение, если в данный момент @@ -356,13 +610,18 @@ Lisp~--- не получилось (я плохо его знал). Потом действия загрузочного агента, поэтому для хранения используется атом. +\item[:child-link] используется в высокоуровневых загрузках для + хранения ссылки из которой создется дочерняя загрузка. + \item[:child] используется в высокоуровневых загрузках для хранения ссылки на дочерние загрузки. \item[:max-running-downloads] определяет максимально допустимое - количество запущенных (т.е. выполняющих некое действие) загрузок - данного типа (т.е. работающих с определенным сервисом). Используется \emph{планировщиком загрузок} и - указывается в прототипе загрузки если ограничение имеет смысл. + количество запущенных (т.е. одновременно выполняющих некое действие) + загрузок данного типа (т.е. работающих с определенным + сервисом). Используется в основном \emph{планировщиком загрузок} и + указывается в прототипе загрузки, если это ограничение имеет смысл + для сетевого сервиса. \end{description} <>= @@ -398,9 +657,9 @@ make-download downloads-precedence-counter (throw (Exception. "Name must be string.")) {:name name}))))] (add-to-downloads dload)))) -@ %def make-download downloads-precedence-counter +@ %def make-download downloads-precedence-counter -Здесь используются функции для добавления и удаления загрузок из +@ Здесь используются функции для добавления и удаления загрузок из множества всех загрузок [[downloads*]]. <>= @@ -417,16 +676,12 @@ downloads* add-to-downloads remove-from-downloads (dosync (alter downloads* difference (hash-set dload)))) @ %def downloads* add-to-downloads remove-from-downloads -Вспомогательные макросы [[with-return]] и [[let-return]] я очень часто +@ Вспомогательные макросы [[with-return]] и [[let-return]] я очень часто использую для явного указания значения, которое возвращает блок кода, потому как большинство функций агентов \emph{обязаны} что-то возвращать, при этом производя некоторые побочные эффекты. -<>= -with-return let-return -@ - -<>= +<>= (defmacro with-return [expr & body] `(do (do ~@body) ~expr)) @@ -437,119 +692,52 @@ with-return let-return (do ~@body)))) @ %def with-return let-return -Макрос [[supplied]] это просто переименованный [[and]], который я +@ Макрос [[supplied]] это просто переименованный [[and]], который я использую для проверки переданных в функцию опциональных ключей-аргументов. -<>= -supplied -@ - -<>= +<>= (defalias supplied and) @ %def supplied -Функция [[as-file]] это своеобразный швейцарский нож для работы с -файлами который я использую в основном для выяснения, существует ли -некий файл с определенными характеристиками. Например -\texttt{(as-file path :directory true :writeable true)} возвращает файл -\texttt{path} если это файл директории доступной для записи, в противном -случае он возвращает [[nil]]. - -Функция написана в «maybe-монадообразном стиле» характерном для кода -на Хаскелле~--- аргумент с помощью макроса-комбинатора прогоняется -через множество maybe-функций, и если на некотором шаге одна из -функций возвращает [[nil]], то и в конце возвращается [[nil]]. +@ \subsection{Прототип загрузки} -<>= -as-file -@ - -<>= -(defn as-file - [arg & {:as args :keys [exists create readable writeable directory]}] - (let [argtype (type arg) - maybe-create - (fn [f] - (when f - (cond (and (= create true) (not (.exists f))) - (let [dir (File. (.getParent f))] - (if-not (.exists dir) - (throw (new Exception - "Cannot create file in nonexistant directory.")) - (if-not (.canWrite dir) - (throw (new Exception - "Cannot create file in nonwriteable directory.")) - (do (.createNewFile f) f)))) - :else f))) - maybe-exists - (fn [f] - (when f - (cond (= exists true) (when (.exists f) f) - (= exists false) (when-not (.exists f) f) - (not exists) f))) - maybe-directory - (fn [f] - (when f - (cond (= directory true) (when (.isDirectory f) f) - (= directory false) (when-not (.isDirectory f) f) - (not directory) f))) - maybe-readable - (fn [f] - (when f - (cond (= readable true) (when (.canRead f) f) - (= readable false) (when-not (.canRead f) f) - (not readable) f))) - maybe-writeable - (fn [f] - (when f - (cond (= writeable true) (when (.canWrite f) f) - (= writeable false) (when-not (.canWrite f) f) - (not writeable) f)))] - - (cond (= argtype File) - (-> arg maybe-create maybe-exists maybe-directory maybe-readable maybe-writeable) - - (= argtype String) - (if args - (apply as-file (new File arg) (flatten (seq args))) - (as-file (new File arg)))))) -@ %def as-file - -@ \paragraph{Прототип загрузки} это обычный хэш, он служит заготовкой -из которой затем собирается тело загрузочного агента. Прототипы -хранятся в глобальной переменной [[download-prototypes*]]~--- это атом -с хэшем в котором ключи~--- метки типов прототипов, а значения~--- -сами прототипы загрузок. +{\emПрототип загрузки} это обычный хэш, он служит заготовкой из которой +затем собирается тело загрузочного агента. Прототипы хранятся в +глобальной переменной [[download-prototypes*]]~— это атом с хэшем в +котором ключи~— метки типов прототипов, а значения~— сами +прототипы загрузок. Прототип загрузки определяется макросом [[def-download-prototype]], этот макрос создают переменную, значением которой является хэш с меткой типа унаследованной от метки \texttt{::download} в ключе \texttt{:type} в метаданных. Диспетчеризация по типу широко -используется в мультиметодах селекторов и действий загрузок. +используется в мультиметодах селекторов и действиях загрузок. <>= -download-prototypes* def-download-prototype +download-prototypes* @ <>= (def download-prototypes* (atom {})) +@ %def download-prototypes* +<>= (defmacro def-download-prototype [name body] `(let [name-keyword# (keyword (str *ns*) (str (quote ~name)))] (def ~name (with-meta ~body {:type name-keyword#})) (derive name-keyword# ::download) (swap! download-prototypes* assoc name-keyword# ~name) ~name)) -@ %def download-prototypes* def-download-prototype +@ %def def-download-prototype @ В качестве исходных данных в лейку передается список ссылок. Причем ссылки с определенными адресами обрабатываются загрузками определенного типа. Для получения прототипа загрузки, которая должна обрабатывать данную ссылку используется функция -[[download-prototype-matching-address]]~--- она выбирает нужный +[[download-prototype-matching-address]]~— она выбирает нужный прототип сравнивая ссылку с регулярным выражением в ключе -\texttt{:link-pattern} в прототипах. +\texttt{:link-pattern} прототипа. <>= download-prototype-matching-address @@ -565,7 +753,7 @@ download-prototype-matching-address (assoc download-prototype :link link))))) @ %def download-prototype-matching-address -Здесь функция [[extract-url]] вырезает из произвольной строки первый +@ Здесь функция [[extract-url]] вырезает из произвольной строки первый попавшийся URL-адрес. <>= @@ -578,16 +766,18 @@ extract-url line))) @ %def extract-url -@ \paragraph{Запуск загрузки} осуществляет метод [[run]]. Во избежание -запуска тела загрузки при работающем агенте или запуска мертвой или -остановленной загрузки перед запуском осуществляются соответствующие -проверки. На время работы агента атом \texttt{run-atom} в теле -загрузки устанавливается в значение [[true]]. Действие \texttt{action} -которое должна выполнить загрузка определяется её программой -\texttt{program} или задается явно опциональным аргументом -\texttt{:action}. Если во время выполнения действия исключений не -возникло~--- загрузка переходит в бездействующее состояние, в -противном случае исключение ловится и сохраняется в теле загрузки. +@ \subsection{Запуск загрузки} + +Запуск осуществляет метод [[run]]. Во избежание запуска тела загрузки +при работающем агенте или запуска мертвой или остановленной загрузки +перед запуском осуществляются соответствующие проверки. На время +работы агента атом \texttt{run-atom} в теле загрузки устанавливается в +значение [[true]]. Действие \texttt{action} которое должна выполнить +загрузка определяется её программой \texttt{program} или задается явно +опциональным аргументом \texttt{:action}. Если во время выполнения +действия исключений не возникло~— загрузка переходит в +бездействующее состояние, в противном случае исключение ловится и +сохраняется в теле загрузки. <>= (defmulti run type-dispatch) @@ -611,7 +801,7 @@ extract-url (finally (reset! run-atom false))))) @ -@ Предикат [[running?]] проверяет~--- запущен ли агент? +@ Предикат [[running?]] проверяет~— запущен ли агент? <>= (defmulti running? type-dispatch) @@ -622,8 +812,9 @@ extract-url (deref (:run-atom dload))) @ -@ \paragraph{Остановка загрузки.} В этой версии программы функция -остановки загрузки не используется. +@ \subsection{Остановка загрузки} + +В этой версии программы функция остановки загрузки не используется. <>= (defmulti stop type-dispatch) @@ -633,7 +824,7 @@ extract-url (defmethod stop ::download [dload]) @ -@ Предикат [[stopped?]] проверяет~--- не остановлен ли агент? +@ Предикат [[stopped?]] проверяет~— не остановлен ли агент? <>= (defmulti stopped? type-dispatch) @@ -644,15 +835,17 @@ extract-url (deref (:stop-atom dload))) @ -@ \paragraph{Базовые действия и предикаты загрузок.} Практически все -функции для работы с загрузками являются мультиметодами и -диспетчеризуются по типу тела агента функцией [[type-dispatch]]. +@ \subsection{Базовые действия и предикаты загрузок} + +Практически все функции для работы с загрузками являются +мультиметодами и диспетчеризуются по типу тела агента функцией +[[type-dispatch]]. <>= type-dispatch @ -<>= +<>= (defn type-dispatch ([x] (type x)) ([x & xs] (type x))) @@ -669,8 +862,8 @@ type-dispatch (assoc dload :failed false :fail-reason nil)) @ -@ Предикат [[idle?]] проверяет~--- находится ли агент в бездействующем -состоянии (то есть агент жив, не запущен, не остановлен и не ошибся +@ Предикат [[idle?]] проверяет~— находится ли агент в бездействующем +состоянии (это значит, что агент жив, не запущен, не остановлен и не ошибся выполняя предыдущее действие)? <>= @@ -685,7 +878,7 @@ type-dispatch (not (failed? dload)))) @ -@ Предикат [[alive?]] проверяет~--- жив ли агент? +@ Предикат [[alive?]] проверяет~— жив ли агент? <>= (defmulti alive? type-dispatch) @@ -696,7 +889,7 @@ type-dispatch (:alive dload)) @ -@ Предикат [[dead?]] проверяет~--- мертв ли агент? +@ Предикат [[dead?]] проверяет~— мертв ли агент? <>= (defmulti dead? type-dispatch) @@ -721,7 +914,7 @@ type-dispatch (assoc dload :failed true :fail-reason reason)) @ -@ Предикат [[failed?]] проверяет~--- возникла ли ошибка во время +@ Предикат [[failed?]] проверяет~— возникла ли ошибка во время выполнения предыдущего действия? <>= @@ -800,11 +993,13 @@ type-dispatch (deref file-length-atom))) @ -@ \paragraph{Планировщик загрузок.} Планировщик загрузок это агент -который обеспечивает совместную работу загрузок друг с другом. +@ \section{Планировщик загрузок} + +Планировщик загрузок это агент который обеспечивает совместную работу +загрузок друг с другом. Планировщик представлен глобальной переменной [[download-scheduler*]] -в которой хранится агент, тело которого~--- хэш с набором ключей +в которой хранится агент, тело которого~— хэш с набором ключей определяющих алгоритм работы планировщика. Большая часть этих ключей используется для отладки планировщика и загрузок. Среди них @@ -821,7 +1016,7 @@ type-dispatch \item[:last-scheduled] это список загрузок которые были запущены последними. Изменяется после каждого запуска планировщика. -\item[:done-hook] этот ключ устанавливается перед запуском +\item[:when-done] этот ключ устанавливается перед запуском планировщика и содержит функцию которая вызывается если нет никаких загрузок которые планировщик мог бы запустить в будущем. Обычно это функция завершения работы программы. @@ -834,12 +1029,12 @@ download-scheduler* <>= (def download-scheduler* (agent {:active true - :done-hook nil ;; run when there are no more scheduling job + :when-done nil ;; run when there are no more scheduling job :schedule-with-callback true :last-scheduled ()})) @ %def download-scheduler* -Основная задача планировщика~--- определить, с учетом всевозможных +Основная задача планировщика~— определить, с учетом всевозможных ресурсных ограничений, какие загрузки нужно запустить; а затем отправить им сообщение запуска [[run]] и сообщение [[callback-download-scheduler]], предписывающее загрузке вызвать @@ -854,16 +1049,16 @@ schedule-downloads <>= (defn schedule-downloads - [{:as scheduler :keys [active done-hook schedule-with-callback last-scheduled]} + [{:as scheduler :keys [active when-done schedule-with-callback last-scheduled]} & {:keys [callback]}] - {:pre [(agent? callback)]} + {:pre [(when-supplied callback (agent? callback))]} (cond - <> + <> <> - :shedule + :otherwise (let [successors <>] <>))) @ %def schedule-downloads @@ -878,18 +1073,18 @@ schedule-downloads @ \item Если нет ни одной загрузки которую когда-нибудь можно будет - запустить~--- все они мертвы или множество загрузок [[downloads*]] + запустить~— все они мертвы или множество загрузок [[downloads*]] пусто, то следует завершить работу планировщика и вызвать функцию - done-hook, если она есть. + when-done, если она есть. <>= (or (not (seq @downloads*)) (every? (comp dead? deref) @downloads*)) (with-return (assoc scheduler :last-scheduled ()) - (when done-hook (done-hook))) + (when when-done (when-done))) @ -\item Составляется список загрузок для запуска~--- {\ttfamily +\item Составляется список загрузок для запуска~— {\ttfamily successors}. Для этого множество всех загрузок [[downloads*]] разбивается на группы по типу; каждая группа загрузок сортируется в порядке появления каждой из загрузок в программе; все это @@ -926,13 +1121,14 @@ schedule-downloads (not callback) (take count-of-dloads-to-launch (concat idle-dloads failed-dloads)) + ;; some download ask to schedule downloads callback (take count-of-dloads-to-launch - (concat idle-dloads (take-entirely-after callback failed-dloads)))))) + (concat idle-dloads (take-entirely-after callback failed-dloads))))))) @ \item Каждой загрузке из списка на запуск {\ttfamily successors} - отсылается сообщение запуска [[run]] и, в зависимости от значения + отсылается сообщение запуска [[run]] и в зависимости от значения ключа {\ttfamily schedule-with-callback}, сообщение для запуска планировщика после того как загрузка выполнит действие. @@ -945,7 +1141,7 @@ schedule-downloads @ \end{enumerate} -Функция [[callback-download-scheduler]] запускает планировщик +@ Функция [[callback-download-scheduler]] запускает планировщик загрузок «от лица» загрузочного агента. <>= @@ -959,7 +1155,18 @@ callback-download-scheduler (send-off download-scheduler* schedule-downloads :callback *agent*)))) @ %def callback-download-scheduler -Предикат [[agent?]] проверяет, является ли его аргумент агентом. +@ Макрос [[when-supplied]] проверяет опциональные аргументы, если они +заданы. + +<>= +(defmacro when-supplied [& clauses] + (if-not clauses true + `(and (or (nil? ~(first clauses)) + (do ~(second clauses))) + (when-supplied ~@(next (next clauses)))))) +@ %def when-supplied + +@ Предикат [[agent?]] проверяет~— является ли его аргумент агентом? <>= agent? @@ -970,10 +1177,11 @@ agent? (instance? clojure.lang.Agent x)) @ %def agent? -Функции семейства \texttt{take-} выбирают элементы последовательности -перед заданным элементом [[take-before]], после заданного элемента -[[take-after]] и все элементы после и перед элементом включая и сам -элемент [[take-entirely-after]] (наивная реализация). +@ Функции семейства \texttt{take-} выбирают элементы +последовательности перед заданным элементом~— [[take-before]], после +заданного элемента~— [[take-after]] и все элементы после и перед +элементом включая и сам элемент~— [[take-entirely-after]] (наивная +реализация). <>= take-after take-before take-entirely-after @@ -994,116 +1202,153 @@ take-after take-before take-entirely-after (list item))))) @ %def take-after take-before take-entirely-after -@ \paragraph{Монитор прогресса.} - -% (declare monitor-progress) +@ \section{Монитор прогресса} -% (declare show-progress) +Монитор это агент который наглядно отображает ход работы программы. Он +определен в глобальной переменной [[progress-monitor*]]. Тело агента +представлено хэшем с расчетом на будущее расширение; оно содержит +единственный ключ {\ttfamily :agents}, его значением является +множество агентов которые в данный момент отображаются в полоске +прогресса в консоли. Для добавления и удаления агентов из этого +множества используются функции [[begin-monitor-progress]] и +[[cease-monitor-progress]]. -% (def eighty-spaces " ") - -% (def progress-monitor* (agent {:agents #{}})) +<>= +progress-monitor* +@ -% (defn begin-monitor-progress [{:as progress-monitor agents :agents} agnt] -% {:pre (agent? agnt)} -% (assoc progress-monitor :agents (union agents (hash-set agnt)))) +<>= +(def progress-monitor* (agent {:agents #{}})) +@ %def progress-monitor* -% (defn cease-monitor-progress [{:as progress-monitor agents :agents} agnt] -% {:pre (agent? agnt)} -% (.print System/out (str "\r" eighty-spaces "\r")) -% (assoc progress-monitor :agents (difference agents (hash-set agnt)))) +<>= +begin-monitor-progress cease-monitor-progress +@ -% (defn monitor-progress [] -% (send-off progress-monitor* show-progress) -% (release-pending-sends)) +<>= +(defn begin-monitor-progress [{:as progress-monitor agents :agents} agnt] + {:pre (agent? agnt)} + (assoc progress-monitor :agents (union agents (hash-set agnt)))) -% (defmacro with-progress-monitoring [agnt & body] -% `(let [agnt?# (agent? ~agnt)] -% (try (when agnt?# (send-off progress-monitor* begin-monitor-progress ~agnt)) -% (do ~@body) -% (finally (when agnt?# (send-off progress-monitor* cease-monitor-progress ~agnt)))))) +(defn cease-monitor-progress [{:as progress-monitor agents :agents} agnt] + {:pre (agent? agnt)} + (.print System/out (str "\r" <> "\r")) + (assoc progress-monitor :agents (difference agents (hash-set agnt)))) +@ %def begin-monitor-progress cease-monitor-progress -% (defn show-progress [{:as progress-monitor agents :agents}] -% (with-return progress-monitor -% (.print System/out \return) -% (doseq [abody (map deref agents) -% :let [name (:name abody) -% name-length (if (string? name) (count name) nil) -% perf (performance abody) -% load-percent (:load-percent perf)]] -% (.print System/out (str \[ (cond (not name) \- -% (< name-length 12) name -% :longer (str (.substring name 0 5) \. \. -% (.substring name (- name-length 7) name-length))) -% \space (or load-percent \0) \% \]))) -% (.print System/out \return))) +@ {\ttfamily eighty-spaces} это просто 80 пробелов в ширину консоли. +<>= +" " +@ -%%%%%%%%%%%% -%%%%%%%%%%%% -%%%%%%%%%%%% +@ Включение и отключение отображения прогресса загрузочного агента +обычно происходит в одном его действии, поэтому имеет смысл +использовать для этого макрос [[with-progress-monitoring]] который об +этом позаботится. + +<>= +(defmacro with-progress-monitoring [agnt & body] + `(let [agnt?# (agent? ~agnt)] + (try (when agnt?# (send-off progress-monitor* begin-monitor-progress ~agnt)) + (do ~@body) + (finally (when agnt?# (send-off progress-monitor* cease-monitor-progress ~agnt)))))) +@ %def with-progress-monitoring + +@ Для отрисовки полосы прогресса в консоли нужно отослать монитору +прогресса [[progress-monitor*]] сообщение [[show-progress]]. Отправка +этого сообщения во время выполнения загрузочным агентом действия +должна сопровождаться вызовом функции {\ttfamily + release-pending-sends} из-за того что агенты в Clojure задерживают все +отправляемые во время действия сообщения до завершения действия. -<>= -;;; -*- mode: clojure; coding: utf-8 -*- +<>= +show-progress +@ -;; Copyright (C) 2010 Roman Zaharov +<>= +(defn show-progress [{:as progress-monitor agents :agents}] + (with-return progress-monitor + (.print System/out \return) + (doseq [abody (map deref agents) + :let [name (:name abody) + name-length (if (string? name) (count name) nil) + perf (performance abody) + load-percent (:load-percent perf)]] + (.print System/out (str \[ (cond (not name) \- + (< name-length 12) name + :longer (str (.substring name 0 5) \. \. + (.substring name (- name-length 7) name-length))) + \space (or load-percent \0) \% \]))) + (.print System/out \return))) +@ %def show-progress + +@ \section{Прототипы загрузок для конкретных сервисов} + +Ниже идут определения прототипов и программ загрузок для скачивания +файлов с конкретных адресов и файлообменников. + +Сетевой код довольно уродливый. Я использую родную для Java библиотеку +Apache HTTP Client за неимением лучшего. Все родные для Clojure +HTTP-клиенты гораздо менее качественны. + +В большинстве HTTP-запросов я использую заранее определенные величины +таймаутов соединений и размера буфера. -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +<>= +timeout-after-fail* connection-timeout* get-request-timeout* head-request-timeout* buffer-size* +@ -(ns leica - (:gen-class) - (:use - [clojure.set :only [difference union]] - [clojure.contrib.duck-streams :only [slurp* read-lines]] - clojure.contrib.command-line - clojure.contrib.def - clojure.test - [log :only [info debug error]] - hooks) +<>= +(def timeout-after-fail* 3000) +(def connection-timeout* 15000) +(def get-request-timeout* 30000) +(def head-request-timeout* 30000) +(def buffer-size* 65536) +@ %def timeout-after-fail* connection-timeout* get-request-timeout* head-request-timeout* buffer-size* - (:require - [clojure.contrib.io :as io]) - - (:import - (java.util Date) +@ \subsection{files*.dsv.*.data.cod.ru} - (java.net URLDecoder - ConnectException) +Прототипы загрузок файлов по прямым ссылкам с местного +файлообменника. С каждого из адресов можно качать в один поток. - (java.io File - FileOutputStream - InputStream) +Алгоритм программы загрузки очень прост: - (org.apache.commons.httpclient URI - HttpClient - HttpStatus - ConnectTimeoutException - NoHttpResponseException - methods.GetMethod - methods.HeadMethod - params.HttpMethodParams - util.EncodingUtil))) +\begin{enumerate} +\item Функция [[files*-dsv-*-data-cod-ru-get-head]] +отправляет на файлообменник запрос HEAD, из него узнается размер и имя +файла. -(declare <>) +\item Функция [[get-local-file]] выбирает локальный файл в +который она будет загружать файл с сервера. -<> +\item Если файл уже полностью загружен или на диске для него нет +места~— загрузка умирает, если все в порядке~— функция [[begin-download]] начинает +загрузку. +\end{enumerate} -<> -@ %language lisp +<>= +files*-dsv-*-data-cod-ru-download-program +@ -<>= -(def timeout-after-fail* 3000) -(def connection-timeout* 15000) -(def get-request-timeout* 30000) -(def head-request-timeout* 30000) -(def buffer-size* 65536) +<>= +(defn files*-dsv-*-data-cod-ru-download-program + [{:as dload :keys [link name file path total-file-length]}] + (cond (not link) die + (not (and name total-file-length)) files*-dsv-*-data-cod-ru-get-head + (not file) get-local-file + (or (out-of-space-on-path? dload) (fully-loaded? dload)) die + :requirements-ok begin-download)) +@ %def files*-dsv-*-data-cod-ru-download-program -(defn actual-file-length [file] - (if (.exists file) (.length file) 0)) +@ Функция [[files*-dsv-*-data-cod-ru-get-head]] отправляет на +файлообменник запрос HEAD, из него узнается размер и имя файла. +<>= +files*-dsv-*-data-cod-ru-get-head +@ +<>= (defn files*-dsv-*-data-cod-ru-get-head [{:as dload :keys [link name]}] {:pre [(supplied link)]} (let [client (new HttpClient) @@ -1125,21 +1370,55 @@ take-after take-before take-entirely-after :name (or name filename)))))) (throw (Exception. "HEAD request failed.")))) (finally (.releaseConnection head))))) +@ %def files*-dsv-*-data-cod-ru-get-head + +@ Функция [[get-local-file]] выбирает локальный файл в который она будет +загружать файл с сервера. + +<>= +get-local-file +@ -(defn get-file [{:as dload :keys [name path]}] +<>= +(defn get-local-file [{:as dload :keys [name path]}] {:pre [(supplied name path)]} (assoc dload :file (new File path name))) +@ %def get-local-file +@ Предикат [[out-of-space-on-path?]] проверяет~— хватает ли места на +локальном диске для загрузки файла? + +<>= +out-of-space-on-path? +@ + +<>= (defn out-of-space-on-path? [{:as dload :keys [path file total-file-length]}] {:pre [(supplied path file total-file-length)]} (if (.exists file) (< (.getUsableSpace path) (- total-file-length (.length file))) (= (.getUsableSpace path) 0))) +@ %def out-of-space-on-path? +@ Предикат [[fully-loaded?]] проверяет~— загружен ли файл полностью? + +<>= +fully-loaded? +@ + +<>= (defn fully-loaded? [{:as dload :keys [file total-file-length]}] {:pre [(supplied file total-file-length)]} (boolean (and (.exists file) (<= total-file-length (.length file))))) +@ %def fully-loaded? + +@ Функция [[begin-download]] скачивает файл. +<>= +begin-download +@ + +<>= (defn begin-download [{:as dload :keys [name link file total-file-length file-length-atom]}] {:pre [(supplied name link file total-file-length)]} @@ -1171,21 +1450,36 @@ take-after take-before take-entirely-after (let [new-size (+ file-size read-size)] (.write output buffer 0 read-size) (reset! file-length-atom new-size) - (when *agent* (monitor-progress)) + (when *agent* + (send-off progress-monitor* show-progress) + (release-pending-sends)) (when-not (stopped? dload) (recur new-size)))))))) (.flush output) (info "End download " name))))) (finally (.releaseConnection get))))) +@ %def begin-download -(defn files*-dsv-*-data-cod-ru-download-program - [{:as dload :keys [link name file path total-file-length]}] - (cond (not link) die - (not (and name total-file-length)) files*-dsv-*-data-cod-ru-get-head - (not file) get-file - (or (out-of-space-on-path? dload) (fully-loaded? dload)) die - :requirements-ok begin-download)) +@ Функция [[actual-file-length]] просто возвращает размер файла в байтах +если он есть и 0~— если его нет. + +<>= +actual-file-length +@ + +<>= +(defn actual-file-length [file] + (if (.exists file) (.length file) 0)) +@ %def actual-file-length + +Прототипы загрузок. +<>= +files*-dsv-*-data-cod-ru files3?-dsv-*-data-cod-ru files2-dsv-*-data-cod-ru +files3?-dsv-region-data-cod-ru files2-dsv-region-data-cod-ru +@ + +<>= (def files*-dsv-*-data-cod-ru {:program files*-dsv-*-data-cod-ru-download-program :max-running-downloads 1 @@ -1206,7 +1500,35 @@ take-after take-before take-entirely-after (def-download-prototype files2-dsv-region-data-cod-ru (assoc files*-dsv-*-data-cod-ru :link-pattern #"http://files2.dsv-region.data.cod.ru/.+")) +@ %def files*-dsv-*-data-cod-ru files3?-dsv-*-data-cod-ru files2-dsv-*-data-cod-ru files3?-dsv-region-data-cod-ru files2-dsv-region-data-cod-ru + +@ \subsection{data.cod.ru} +Прототип загрузки для пользовательской страницы файлообменников data.cod.ru. + +Программа загрузки предельно проста: она вырезает из страницы +файлообменника прямую ссылку на файл и создает дочернюю загрузку с +прямой ссылкой. + +<>= +data-cod-ru-download-program +@ + +<>= +(defn data-cod-ru-download-program [{:as dload :keys [link child-link child]}] + (cond (not link) data-cod-ru-parse-page + (not child) data-cod-ru-make-child-download + :finally die)) +@ %def data-cod-ru-download-program + +@ Функция [[data-cod-ru-parse-page]] вырезает из страницы прямую ссылку +на файл. + +<>= +data-cod-ru-parse-page +@ + +<>= (defn data-cod-ru-parse-page [{:as dload :keys [link]}] {:pre [(supplied link)]} (let [client (new HttpClient) @@ -1223,20 +1545,32 @@ take-after take-before take-entirely-after (die dload))) (throw (Exception. "Fail to parse page.")))) (finally (.releaseConnection get))))) +@ %def data-cod-ru-parse-page + +@ Функция [[data-cod-ru-make-child-download]] создает дочернюю загрузку +если загрузки с такой ссылкой еще нет. -(defn data-cod-ru-make-child-download [{:as dload :keys [link child-link path]}] +<>= +data-cod-ru-make-child-download +@ + +<>= +(defn data-cod-ru-make-child-download [{:as dload :keys [link child child-link path]}] {:pre [(supplied link child-link path)]} - (let [child (or (first (for [dl @downloads* :when (= child-link (:link @dl))] dl)) - (make-download child-link :path path))] - (if-not child - (die dload) - dload))) + (if child dload + (let [child (or (first (for [dl @downloads* :when (= child-link (:link @dl))] dl)) + (make-download child-link :path path))] + (if-not child (die dload) + (assoc dload :child child))))) +@ %def data-cod-ru-make-child-download -(defn data-cod-ru-download-program [{:as dload :keys [link child-link child]}] - (cond (not link) data-cod-ru-parse-page - (not child) data-cod-ru-make-child-download - :finally die)) +Объявление прототипа. +<>= +data-cod-ru +@ + +<>= (def-download-prototype data-cod-ru {:link-pattern #"http://[\w\-]*.data.cod.ru/\d+" :program data-cod-ru-download-program @@ -1244,45 +1578,12 @@ take-after take-before take-entirely-after :path nil :child-link nil :child nil}) +@ %def data-cod-ru +@ \section{Послесловие} -(def help* - "Leica -- downloader written in lisp. - -Download files: - -leica [keys] [file with links] [directory]") - -(defn exit-program [] - (debug "Leica is done. Bye.") - (System/exit 0)) - -(defn -main [& args] - (with-command-line args help* - [[quiet? q? "work quietly"] - [debug? d? "write debug messages"] - remaining-args] - - (let [lines-with-links - (read-lines (some #(as-file % :readable true :directory false) remaining-args)) - - workpath - (or (some #(as-file % :writeable true :directory true) remaining-args) - (as-file (System/getProperty "user.dir") :writeable true :directory true))] - - (when-not lines-with-links - (info "You must specify file with links to download.") - (exit-program)) - - (when-not workpath - (info "You must specify directory in which files will be downloaded.") - (exit-program)) - - (doseq [line lines-with-links] - (make-download line :path workpath)) - - (send-off download-scheduler* assoc :done-hook exit-program) - (send-off download-scheduler* schedule-downloads)))) -@ +Поздравляю. Надеюсь, вы не зря потратили свое время, если смогли +дочитать до этого места. Не стесняйтесь использовать и дополнять эту +программу своим кодом, она хранится на гитхабе в репозитории http://github.com/zahardzhan/leica. \end{document}