Наш пользователь может быть зарегистрирован на http://motobratan.ru
Чтобы предоставлять ему разнообразные сервисы, отсутстующие на на мотобратане, мы отражаем профили пользователя мотобратана у себя. Для этого мы забираем данные со страниц пользователей на мотобратане.
Центральной частью этого процесса является функция process-user, которая принимает в
качестве параметра целочисленный идентификатор пользователя на мотобратане, получает
данные пользователя со страницы помощью get-user-plist, подготавливает их к сохранению
с помощью prepare-to-save, и, наконец, сохраняет их с помощью save-bratan.
В ней же предоставляются перезапуски, которые используются вызывающим кодом:
malformed-user-page-error- Не удалось получить данные пользователя со страницыuser-name-empty-error- При подготовке к сохранению в базу обнаружилось что имя пользователя - пустая строкаsuspicious-reg-date-error- Подозрительная дата регистрации - совпадает с принятой по умолчанию, возможно профиль не заполнен.
Так как слишком долго ждать пока все пользователи последовательно будут скачаны и обработаны мы распарралелим эту операцию и заставим ее выполняться в несколько потоков. Чтобы не слишком нагружать сервер кол-во потоков должно быть меньше ста.
Чтобы разбить весь сканируемый дипазон на нужное кол-во кусков испольуем функцию
split-to-blocks, которую вызывает функция make-process-users-threads которая и
занимается запуском потоков.
По странной причине, реальные пользователи начинаются с id = 10001, и это, что характерно, Ветер. Так что мы не будем смотреть тех кто меньше 10001.
(in-package #:moto)
(defun process-user (user-id)
(handler-case
(let ((user-plist (get-user-plist user-id)))
(let ((prepared (prepare-to-save user-plist)))
(save-bratan prepared)))
(skip-record-error (c) (format t "~%skipped:~%~A" (bprint (text c))))))
(defparameter *stop* nil)
(defun process-users-array (from to)
(loop :for i :from from :to to :do
;; (print i)
(when *stop*
(err "stopped!"))
(process-user i)))
<<bratan_fn>>
(defun split-to-blocks (from to cnt-blocks)
(let ((cnt-elts (- to from)))
(multiple-value-bind (quotient remainder)
(ceiling cnt-elts cnt-blocks)
(let ((size-block (if (equal 0 remainder)
(+ 1 quotient)
quotient)))
(loop :for i :from from :to to :by size-block
:collect (list i
(let ((end (+ i (- size-block 1))))
(if (> to end) end to))))))))
(defun make-process-users-threads (from to cnt-blocs)
(loop :for (start end) :in (split-to-blocks from to cnt-blocs) :do
(bordeaux-threads:make-thread
#'(lambda ()
(handler-bind
((user-name-empty-error #'(lambda (c)
(invoke-restart 'skip-this-record)))
(suspicious-reg-date-error #'(lambda (c)
(invoke-restart 'ignore-date))))
(process-users-array start end))
:name (format nil "~A..~A" start end)))))
;; (make-process-users-threads 10001 40104 50)
;; (print (bordeaux-threads:all-threads))
;; (length (bordeaux-threads:all-threads))
;; (floor (- 40104 10001) 50)Здесь настройки DRAKMA и вспомогательные функции и макросы, которые обеспечивают получение данных со сторонних ресурсов и поиск в них интересующих нас элементов
(defparameter *user-agent* "Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:33.0) Gecko/20100101 Firefox/33.0")
(defparameter *cookies*
(list "portal_tid=1291969547067-10909"
"__utma=189530924.115785001.1291969547.1297497611.1297512149.377"
"__utmc=3521885"))
(setf *drakma-default-external-format* :utf-8)
(defun get-headers (referer)
`(
("Accept" . "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
("Accept-Language" . "ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3")
("Accept-Charset" . "utf-8")
("Referer" . ,referer)
;; ("Cookie" . ,(format nil "~{~a; ~}" *cookies*))
("Cookie" . "ad20c=2; ad17c=2; __utma=48706362.2093251633.1396569814.1413985658.1413990550.145; __utmz=48706362.1413926450.142.18.utmcsr=vk.com|utmccn=(referral)|utmcmd=referral|utmcct=/im; email=avenger-f%40yandex.ru; password=30e3465569cc7433b34d42baeadff18f; PHPSESSID=ms1rrsgjqvm3lhdl5af1aekvv0; __utmc=48706362; __utmb=48706362.5.10.1413990550")
))
(defmacro web (to ot)
(let ((x-to (append '(format nil) to))
(x-ot (append '(format nil) ot)))
`(let ((r (sb-ext:octets-to-string
(drakma:http-request ,x-to
:user-agent *user-agent*
:additional-headers (get-headers ,x-ot)
:force-binary t)
:external-format :utf-8)))
r)))
(defmacro fnd (var pattern)
`(multiple-value-bind (all matches)
(ppcre:scan-to-strings ,pattern ,var)
(let ((str (format nil "~a" matches)))
(subseq str 2 (- (length str) 1)))))Мы получаем страницу пользователя по его целочисленному идентификатору и извлекаем из нее данные. Извлекаемые данные возвращаются в формате plist.
Если по какой-то причине не удалось получить данные, например сервер вернул 502 ошибку,
функция сигнализирует ошибку malformed-user-page-error.
(in-package #:moto)
(define-condition malformed-user-page-error (error)
((text :initarg :text :reader text)))
(defun get-user-page (user-id)
(web ("http://www.motobratan.ru/users/~A.html" user-id)
("http://www.motobratan.ru/")))
(defun get-user-plist (user-id)
"Получает идентификатор пользователя и извлекает данные этого пользователя с мотобратана"
(let* ((page (get-user-page user-id))
(head (fnd page "(?s)<div class=\"headClass\">(.*)<div class=\"clear\">")))
(when (equal head "")
(error 'malformed-user-page-error))
(list
:bratan-id user-id
:fio (let ((tmp (fnd head "(?s)<div class=\"\">(.*)<div class=\"flow\">(.*)<div class=\"item flow\">(.*)</div>(.*)<div class=\"item flow\">")))
(fnd tmp "<div class=\"item flow\">(.*)</div>"))
:name (fnd head "<h1>(.*)</h1>")
:last-seen (let ((tmp (replace-all (fnd head "<div class=\"link flow small\">(.*)</div>") " " " ")))
(if (equal "" tmp)
""
(ppcre:regex-replace "Был(а)? в сети " tmp "")))
:addr (let* ((tmp (fnd head "(?s)<div class=\"\">(.*)<div class=\"flow\">(.*)Регистрация")))
(let ((tmp (fnd tmp "<div class=\"item flow\">(.*)</div>")))
tmp))
:ts-reg (fnd head "<noindex><div class=\"flow\">Регистрация: (.*)</div></noindex>")
:age (let ((tmp (fnd head "<div class=\"flow\">Возраст: (.*)<span class=\"small gray\">")))
(if (equal "" tmp)
""
(car (ppcre:split " " tmp))))
:birthday (fnd head "<span class=\"small gray\"> (.*)</span></div>")
:blood (fnd head "<noindex><div class=\"\">Группа крови: (.*)</div></noindex>")
:moto-exp (fnd head "<noindex><div class=\"\">Мото-стаж: (.*)</div></noindex>")
:phone (fnd head "<div class=\"item flow\">Телефон: (.*)</div>")
:activityes (let* ((tmp (fnd head "(?s)<div class=\"lerge\">Деятельность</div>(.*)<div class=\"boxFlowTop\">"))
(tmp2 (fnd tmp "(?s)<div>(.*)</div>")))
(fnd tmp2 "(?s)(.*)</div>"))
:interests (let* ((tmp (fnd head "(?s)Интересы</div>(.*)"))
(tmp2 (fnd tmp "(?s)<div>(.*)</div>" ))
(tmp3 (fnd tmp2 "(?s)(.*)</div>")))
(fnd tmp3 "(?s)(.*)</div>"))
:photos (let* ((tmp (fnd head "(?s)<div id=\"photos_id\"><div class=\"images\">(.*)</div></div>")))
(if (equal "" tmp)
""
(ppcre:all-matches-as-strings "http://[a-z0-9-\.]*/photos/normal/[0-9]*/[0-9]*\.jpg" tmp)))
:avatar (let* ((tmp (fnd page "(?s)<div class=\"boxLeft boxFlowRight\">(.*)"))
(tmp2 (fnd tmp "<div class=\"image\"><img alt=\"(.*)</div>")))
(fnd tmp2 "src=\"(.*)\" width"))
:motos (let* ((tmp (fnd page "(?s)<div class=\"boxRight boxFlowLeft\">(.*)<div class=\"boxCenter\">"))
(lst (ppcre:split "<div class=\"item flow\">" tmp)))
(if (equal "" tmp)
nil
(loop :for elt :in lst :collect
(progn
(let* ((img (let ((tmp (fnd elt "<div class=\"image\"><img src=\"(.*)\" width=\"240\"")))
(when (equal "" tmp)
(setf tmp (fnd elt "<img src=\"(.*)\" width=\"240\"")))
tmp))
(namelist (ppcre:split "\\s+"
(ppcre:regex-replace
"металлик"
(fnd elt "<div class=\"lerge\"><a href=\"(.*)\">(.*)</a></div>")
""))))
(if (null namelist)
nil
(list :img img
:lnk (car namelist)
:year (car (last namelist))
:color (cadr namelist)
:vendor (caddr namelist)
:name (format nil "~{~A~^ ~}" (cdddr (butlast namelist)))))))))))))Перед тем, как сохранить в базу данные их необходимо подготовить. Если в данных
отсутствует name сигнализируется ошибка user-name-empty-error
(in-package #:moto)
(define-condition user-name-empty-error (error)
((text :initarg :text :reader text))
(:report (lambda (condition stream)
(format stream "Имя пустое:~%~A"
(bprint (text condition))))))
(define-condition suspicious-reg-date-error (error)
((text :initarg :text :reader text))
(:report (lambda (condition stream)
(format stream "Подозрительная дата регистрации:~%~A"
(bprint (text condition))))))
(define-condition skip-record-error (error)
((text :initarg :text :reader text)))
(defun prepare-to-save (plist)
(setf (getf plist :name)
(string-trim '(#\Space #\Newline #\Tab)
(getf plist :name)))
(restart-case
(when (equal (getf plist :name) "")
(error 'user-name-empty-error :text plist))
(ignore-empty-name () "")
(skip-this-record () (error 'skip-record-error :text plist))
;; (enter-name-manually () "")))
)
(restart-case
(when (equal (getf plist :ts-reg) "1 января 1970")
(error 'suspicious-reg-date-error :text plist))
(ignore-date () "")
(skip-this-record () (error 'skip-record-error :text plist)))
plist)При сохранении данных пользователя мы проверяем, нет ли уже сохраненной записи об этом пользователе, и если она есть - обновляем запись.
(in-package #:moto)
(defun save-bratan (p)
"Принимает plist пользователя и создает/обновляет сущность в базе"
;; Если в наборе есть непустой список мотоциклов
;; (format t "~%:[1]:~A" (bprint (getf p :motos)))
(let ((result (unless (null (getf p :motos))
;; То для каждого мотоцикла
(loop :for moto :in (getf p :motos) :collect
;; Который не равен nil
(unless (null moto)
(list
;; Вычисляем цвет
:color-id (let ((color (getf moto :color)))
(aif (find-color :name color)
(id (car it))
(id (make-color :name color))))
;; Вычисляем производителя
:vendor-id (let ((vendor (getf moto :vendor)))
(aif (find-vendor :name vendor)
(id (car it))
(id (make-vendor :name vendor))))
;; Добавляем остальные поля без изменений
:img (getf moto :img)
:lnk (getf moto :lnk)
:year (getf moto :year)
:name (getf moto :name)))))))
(setf (getf p :motos) result)
;; (format t "~%:[2]:~A" (bprint result))
;; Ищем запись братана в базе данных
(aif (find-bratan :bratan_id (getf p :bratan-id))
;; Найдены записи, обновляем первую, остальные удаляем
(let ((rec (car it)))
;; Удаление дублей
(unless (null (cdr it))
(loop :for d :in (cdr it) :do
(del-bratan (id d))))
;; Обновление записи
(progn
(setf (getf p :photos)
(bprint (getf p :photos)))
(setf (getf p :motos)
(bprint (getf p :motos)))
(setf (getf p :ts-last-upd)
(get-universal-time))
(upd-bratan rec p)))
;; Записи не найдены, вставляем новую
(progn
(make-bratan
:bratan-id (getf p :bratan-id)
:ts-last-upd (get-universal-time)
:fio (getf p :fio)
:name (getf p :name)
:last-seen (getf p :last-seen)
:addr (getf p :addr)
:ts-reg (getf p :ts-reg)
:age (getf p :age)
:birthday (getf p :birthday)
:blood (getf p :blood)
:moto-exp (getf p :moto-exp)
:phone (getf p :phone)
:activityes (getf p :activityes)
:interests (getf p :interests)
:photos (format nil "~A" (bprint (getf p :photos)))
:avatar (getf p :avatar)
:motos (bprint (getf p :motos)))))))
;; (process-users-array 10201 10220)
Здесь все, что относится к мотоциклам пользователей. Мы хотим, чтобы пользователи не только могли рассказать о своих мотоциклах, но и купить/продать их, убедившись в легальности и нескрученном пробеге, изучив историю и динамику цен.
В начале и конце сезона можно организовывать акции по контролю пробега например, за которые начислять карму.
Для начала, стандартные поля - марка, модель, цвет и год выпуска.
У каждого мотоцикла также есть цена за которую владелец готов его продать.
Поля, которые пользователь может заполнить по желанию - описание мотоцикла, описание тюнинга.
Поля, которые не показываются всем подряд: номерной знак, номер рамы, номер двигателя - все это может пригодиться для проверки мотоцикла на легальность.
| field name | field type | default | meta | note |
|---|---|---|---|---|
| id | serial | (primary) | идентификатор | |
| vendor-id | (or db-null integer) | ((one-to-many (vendor id))) | идентификтор фирмы-производителя | |
| model-id | (or db-null integer) | идентификтор модели | ||
| color-id | (or db-null integer) | ((one-to-many (color id))) | идентификтор цвета | |
| year | (or db-null integer) | год выпуска | ||
| price | (or db-null integer) | цена | ||
| plate | (or db-null varchar) | номерной знак | ||
| vin | (or db-null varchar) | vin-номер | ||
| frame-num | (or db-null varchar) | номер рамы | ||
| engine-num | (or db-null varchar) | номер двигателя | ||
| pts-data | (or db-null varchar) | данные птс (раскрыть) | ||
| desc | (or db-null varchar) | описание мотоцикла | ||
| tuning | (or db-null varchar) | описание тюнинга |
В нашей системе мотоцикл может существовать (или не существовать) в одном их нескольких состояний:
используетсяМотоцикл на ходу, может быть выставлен на продажу, разбит, сломан или угнан.продаетсяМотоцикл может быть продан. В этом состоянии мотоцикл находится в поиске. Хозяин может отменить продажу мотоцикла, если его слишком достали звонками, например. Хозяин может осуществить продажу, в этом случае, мотоцикл переходит в состояниепродан.продан. Продавец ставит этот статус, расставаясь с мотоциклом.куплен. Покупатель ставит этот статус, получая мотоциклсломанПоломан настолько, что поломка препятствует эксплуатации. Отсюда есть только путь в сервис или на разборку. Конечно ломаный мотоцикл могут еще украсть или продать, но мы не продаем ломаные мотоциклы, это уже в раздел запчастей.угнанУкраден (в угоне). Дальше в дневнике может быть только где его видели. Может быть возвращен владельцу, а также сломан или разбит ворами.чинится(в сервисе - эксплуатация невозможна). Этот статус устанавливаетservice-manпри получени мотоцикла. При переводе мотоцикла обратно в эксплуатацию по идее должен занести в дневник список выполненных работ и сумму оплаты. Однако иногда починить мотоцикл не удается, тогда он остается сломанным, однако в сервисной книжке появляется запись о попытке починить. Иногда в процессе ремонта оказывается, что дешевле объявить мотоцикл хламом, чем чинить.хламРазбит (и восстановлению не подлежит)
Все эти состояния и переходы между ними сведем в единую таблицу:
| action | from | to |
|---|---|---|
| выставление.на.продажу | используется | продается |
| сломался | используется | сломан |
| крэш | используется | хлам |
| угон | используется | угнан |
| воры.повредили | угнан | сломан |
| воры.разбили | угнан | хлам |
| отмена.выставления.на.продажу | продается | используется |
| отвоз.в.ремонт | сломан | чинится |
| доломал | сломан | хлам |
| неосилил.починить | чинится | сломан |
| починил | чинится | используется |
| здесь.не.починишь | чинится | хлам |
| продажа | продается | продан |
| покупка | продан | куплен |
| ввод.в.эксплуатацию | куплен | используется |
| возврат.с.угона | угнан | используется |
Теперь мы можем полностью описать поведение мотоцикла как конечный автомат:
Теперь сгенерируем код и определим функции, которые вызываются на переходах
Не забываем про аватар, который показывается на страничке пользователя и про набор фоток
этого мотоцикла, доступный через таблицу связи moto2motophoto. Аватаром является фотка
мотоцикла, со статусом active.
Поскольку у мотоцикла может быть несколько владельцев, и один пользователь может владеть
несколькими мотоциклами, то мы связываем мотоцикл и его владельца через таблицу связи с
диапазоном дат - moto2user, при этом, если даты пересекаются - то два пользователя,
очевидно, владеют мотоциклами вместе. Таким образом мы можем отследить историю
мотоцикла, с момента его появления, до разборки. Учитывая планируемую “технологическую
репутацию” пользователей это поможет сделать вывод о том, как с мотоциклом обращались.
Дневник мотоцикла. Что случалось с мотоциклом - поломки, участие в прохватах,
поездках-путешествиях, ремонт в сервисах - все это привязывается из motodiary. Это
позволяет еще и отслеживать траты на мотоцикл.
Также у каждого мотоцикла есть wish-list - то, что хозяин хотел бы приобрести для
него. Мы храним это в таблице motowish, которая содержит ссылку на мотоцикл и его
владельца, а также на товар, если он существует в базе товаров.
(in-package #:moto)
;; (loop :for item :in (with-connection *db-spec*
;; (query
;; (:limit
;; (:select 'motos
;; :from 'bratan
;; :where (:not (:like "" 'motos)))
;; 999999999999))) :do
;; (format t "~%~A"
;; (ppcre:split "\\s+" (car item))))Цвета мотоциклов - простая сущность и не имеет состояния.
| field name | field type | default | meta | note |
|---|---|---|---|---|
| id | serial | (primary) | идентификатор | |
| name | varchar | имя цвета |
Производитель мотоциклов - простая сущность и не имеет состояния.
| field name | field type | default | meta | note |
|---|---|---|---|---|
| id | serial | (primary) | идентификатор | |
| name | varchar | имя производителя |
Наш пользователь может быть зарегистрирован на http://motobratan.ru
Чтобы предоставлять ему разнообразные сервисы, отсутстующие на на мотобратане, мы отражаем профили пользователя мотобратана у себя. Наш пользователь может связать свой профиль с профилем на мотобратане.
Братан является простой сущностью и не имеет состояния.
| field name | field type | default | meta | note |
|---|---|---|---|---|
| id | serial | (primary) | идентификатор | |
| bratan-id | (or db-null integer) | идентификтор на мотобратане | ||
| ts-last-upd | (or db-null bigint) | время последнего обновления данных | ||
| name | varchar | имя | ||
| fio | (or db-null varchar) | ФИО | ||
| last-seen | (or db-null varchar) | последнее посещение мотобратана | ||
| addr | (or db-null varchar) | район и город | ||
| ts_reg | (or db-null varchar) | время регистрации | ||
| age | (or db-null varchar) | возраст | ||
| birthday | (or db-null varchar) | день рождения | ||
| blood | (or db-null varchar) | группа крови | ||
| moto-exp | (or db-null varchar) | стаж мотовождения | ||
| phone | (or db-null varchar) | телефон | ||
| activityes | (or db-null varchar) | активность | ||
| interests | (or db-null varchar) | интересы | ||
| photos | (or db-null varchar) | фотографии | ||
| avatar | (or db-null varchar) | аватар | ||
| motos | (or db-null varchar) | мотоциклы |