Регистрация | Войти
Lisp — программируемый язык программирования
Предыдущая Оглавление Следующая

27. Практика: База данных для MP3

В этой главе мы заново рассмотрим идею, впервые упомянутую в главе Chapter 3 – построение базы данных, расположенной в памяти, на основе базовых типов данных Lisp. Сейчас нашей целью является хранение информации, которую вы извлечете из коллекции файлов в формате MP3 при помощи библиотеки ID3v2 из главы 25. Вы затем будете использовать эту базу данных в главах 28 и 29 как часть потокового MP3-сервера с Web-интерфейсом. Конечно сейчас вы уже можете использовать некоторые из языковых конструкций, изученных со времени изучения главы 3, чтобы создать более совершенный код.

База данных

Основной проблемой базы данных из главы 3 является то, что есть только одна таблица – список, сохраненный в переменной *db*. Другой проблемой является то, что код ничего не знает о типах значений, сохраненных в разных колонках. В главе 3 вы просто использовали функцию общего назначения EQUAL для сравнения значений в колонках при выборе строк из базы данных, но у вас были бы проблемы, если бы вы хотели бы сохранить значения, которые не сравниваются с помощьюEQUAL, или если бы вы хотели сортировать строки в базе данных, поскольку не такой функции сравнения, похожей на EQUAL.

Сейчас вы будете решать обе проблемы путем определения класса table, который будет описывать отдельные таблицы базы данных. Каждый экземпляр класса table будет состоять из двух слотов – один для хранения данных, а второй – для хранения информации о колонках таблицы, которую смогут использовать функции для работы с базой данных. Класс выглядит примерно вот так:

(defclass table ()
  ((rows   :accessor rows   :initarg :rows :initform (make-rows))
   (schema :accessor schema :initarg :schema)
)
)

Также как и в главе 3, вы можете представлять отдельные строки в виде списков свойств, но сейчас время вы создадите абстракцию, которая позволит вам изменять внутренее представление без особых трудностей. И в данной версии вы будет сохранять данные в векторе, а не в списке свойств, поскольку некоторые операции, которые вы будете поддерживать, например, произвольный доступ к строкам по числовому индексу, и возможность сортировки таблицы, могут быть более эффективно реализованы с помощью векторов.

Функция make-rows, используемая для инициализации слота rows может быть простой оберткой для функции MAKE-ARRAY, которая создает пустой вектор с изменяемым размером и указателем заполнения.

FIXME this should be inside of table/box Пакет

Объявление пакета для разрабатываемого вами в этой главе кода будет выглядеть следующим образом:

(defpackage :com.gigamonkeys.mp3-database
  (:use :common-lisp
        :com.gigamonkeys.pathnames
        :com.gigamonkeys.macro-utilities
        :com.gigamonkeys.id3v2
)

  (:export  :*default-table-size*
            :*mp3-schema*
            :*mp3s*
            :column
            :column-value
            :delete-all-rows
            :delete-rows
            :do-rows
            :extract-schema
            :in
            :insert-row
            :load-database
            :make-column
            :make-schema
            :map-rows
            :matching
            :not-nullable
            :nth-row
            :random-selection
            :schema
            :select
            :shuffle-table
            :sort-rows
            :table
            :table-size
            :with-column-values
)
)

Раздел :use дает возможность доступа к функциям и макросам, чьи имена экспортированы из пакетов, созданных в главах 15, 8 и 25, а секция :export используется для объявления функций, реализуемых данным пакетом, и которые будут использоваться в главе 29.

FIXME end of table/box

(defparameter *default-table-size* 100)

(defun make-rows (&optional (size *default-table-size*))
  (make-array size :adjustable t :fill-pointer 0)
)

Для представление схемы таблицы, вам необходимо определить еще один класс – column, каждый экземпляр которого будет содержать информацию об одной колонке в таблице: ее название, способ сравнения значений в колонке на равенство и порядок расположения, значение по умолчанию, а также функцию, которая будет использоваться для нормализации значения при вставке данных в таблицу и при запросе данных из таблицы. Слот schema будет хранить список объектов типа column. Определение класса будет выглядеть примерно вот так:

(defclass column ()
  ((name               
    :reader name
    :initarg :name
)


   (equality-predicate
    :reader equality-predicate
    :initarg :equality-predicate
)


   (comparator
    :reader comparator
    :initarg :comparator
)


   (default-value
    :reader default-value
    :initarg :default-value
    :initform nil
)


   (value-normalizer
    :reader value-normalizer
    :initarg :value-normalizer
    :initform #'(lambda (v column) (declare (ignore column)) v)
)
)
)

Слоты equality-predicate и comparator объекта column хранят функции, которые будут использоваться для сравнения значений данной колонки на равенство и порядок расположения. Например, для колонки, которая будет хранить строковые значения, мы можем использовать функции STRING= в качестве значения equality-predicate и STRING< для comparator, тогда как колонки, хранящие числа, могут использовать функции = и <.

Слоты default-value и value-normalizer используются при вставке и при запросе данных (слот value-normalizer). Когда вы вставляет строку в базу данных, и для определенной колонки не указано значение, то вы можете использовать значение, хранящееся в слоте default-value данной колонки. Затем, значение (значение по умолчанию или указанное пользователем) нормализуется путем передачи его и объекта, описывающего колонку в БД, в качестве параметров функции, указанной в слоте value-normalizer. Вы передаете объект типа column поскольку для функции value-normalizer может понадобиться некоторые данные, связанные с объектом column. (Вы увидите пример такого использования в следующем разделе). Вы также должны нормализовывать значения, передаваемы в запросах, до их сравнения с объектами в базе данных.

Таким образом, value-normalizer отвечает за возврат значения, которое может быть спокойно переданно функциям equality-predicate и comparator. Если value-normalizer не может найти подходящее возвращаемое значение, то она сгенерирует ошибку.

Другой причиной для нормализации значений до их сохранения в БД является возможность уменьшить потребление памяти и процессора. Например, если у вас есть колонка, которая должна хранить строковые значения, но количество значений, которые будут сохранены является ограниченным – например, колонка genre (жанр) в базе данных MP3-файлов, то вы можете уменьшить потреление памяти и увеличить скорость работы, путем использования функции value-normalizer для интернирования (FIXME intern - написать что это такое) строк (преобразовать все вызовы STRING= к одному объекту-строке). Так что вам нужно будет иметь столько строковых объектов, сколько у вас имеется различающихся строк, вне зависимости от того, сколько строк у вас в таблице, и вы тогда сможете использовать для сравнения функцию EQL, а не STRING=, которая является более медленной.1)

Определение схемы базы данных

Таким образом, чтобы создать экземпляр таблицы, вам необходимо создать список объектов column objects. Вы можете создать такой список вручную, используя функции LIST и MAKE-INSTANCE. Но вы скоро заметите, что вы часто создаете множество объектов column с одинаковыми комбинациями функций comparator и equality-predicate. Это происходит оттого, что комбинация функций сравнения по существу определяет тип колонки. Было бы хорошо, если бы был способ определить имена для этих типов, что позволит вам просто указывать, что конкретная колонка является строковй, вместо того, чтобы указывать STRING< и STRING= в качестве функций сравнения. Одним из способов решения этой проблемы является определение обобщенной функции, make-column, например, вот так:

(defgeneric make-column (name type &optional default-value))

Теперь вы можете определять методы данной обобщенной функции, специализированные для типа, с использованием EQL, которые будут возвращать объекты column со слотами, заполненными соответствующими значениями. Вот определения для методов, которые определяют типы колонок с именами string и number:

(defmethod make-column (name (type (eql 'string)) &optional default-value)
  (make-instance
   'column
   :name name
   :comparator #'string<
   :equality-predicate #'string=
   :default-value default-value
   :value-normalizer #'not-nullable
)
)


(defmethod make-column (name (type (eql 'number)) &optional default-value)
  (make-instance
   'column
   :name name
   :comparator #'<
   :equality-predicate #'=
   :default-value default-value
)
)

Следующая функция – not-nullable, используется в качестве значения value-normalizer для строковых колонок, и просто возвращает переданное значение для всех случаев, кроме тех, когда ей передают значение NIL, когда она сигнализирует об ошибке:

(defun not-nullable (value column)
  (or value (error "Column ~a can't be null" (name column)))
)

Это важно, поскольку вызовы STRING< и STRING= будут выдавать ошибку, если им будут передан NIL; лучше перехватить неправильные значения до того, как они будут вставлены в таблицу, а не тогда, когда мы будем их использовать.2)

Еще одним типом колонки, который понадобится для базы данных MP3 является interned-string, чьи значения интернируются, как это обсуждалось выше. Поскольку вам нужна хэш-таблица, в которую вы будете интернировать значения, вы должны определить подкласс columninterned-values-column, который добавит еще один слот, чьим значением будет хэш-таблица, которая будет использоваться для интернирования.

Для реализации интернирования, вам потребуется указать в качестве :initform для слота value-normalizer функцию, которая будет интернировать значение в хэш-таблицу, которая хранится в колонке interned-values. И поскольку, одна из самых главных причин интенирования значений – возможность использования EQL в качестве функции равенства, то вы также должны добавить #'eql в качестве значения :initform для слота equality-predicate.

(defclass interned-values-column (column)
  ((interned-values
    :reader interned-values
    :initform (make-hash-table :test #'equal)
)

   (equality-predicate :initform #'eql)
   (value-normalizer   :initform #'intern-for-column)
)
)


(defun intern-for-column (value column)
  (let ((hash (interned-values column)))
    (or (gethash (not-nullable value column) hash)
        (setf (gethash value hash) value)
)
)
)

Затем вы можете определить метод make-column специализированный для имени interned-string, который будет возвращать экземпляр interned-values-column.

(defmethod make-column (name (type (eql 'interned-string)) &optional default-value)
  (make-instance
   'interned-values-column
   :name name
   :comparator #'string<
   :default-value default-value
)
)

С помощью данных методов, определенных для make-column, вы теперь можете определить функцию, make-schema, которая создат список объектов типа column из списка описаний колонок, каждое из которых содержит имя колонки, имя типа колонки, и, необязательно, значение по умолчанию.

(defun make-schema (spec)
  (mapcar #'(lambda (column-spec) (apply #'make-column column-spec)) spec)
)

Например, с помощью следующего кода вы можете определить схему для таблицы, которая будет использоваться для хранения данных, извлеченных из файлов MP3:

(defparameter *mp3-schema* 
  (make-schema
   '((:file     string)
     (:genre    interned-string "Unknown")
     (:artist   interned-string "Unknown")
     (:album    interned-string "Unknown")
     (:song     string)
     (:track    number 0)
     (:year     number 0)
     (:id3-size number)
)
)
)

Чтобы создать саму таблицу для хранения информации о файлах MP3, вы должны передать *mp3-schema* в качестве аргумента :schema функции MAKE-INSTANCE.

(defparameter *mp3s* (make-instance 'table :schema *mp3-schema*))

Вставка значений

Сейчас вы готовы к тому, чтобы определить вашу первую операцию для работы с таблицами – insert-row, которая получает список свойств (plist) имен и значений, и таблицу, и добавляет строку к таблице. Большая часть работы выполняется в дополнительной функции normalize-row, которая создает список свойств для всех колонок таблицы, используя нормализованные значения и значения по умолчанию, которые получаются из слотов names-and-values, если значение было указано, или default-value если значение для конкретной колонки не было указано.

(defun insert-row (names-and-values table)
  (vector-push-extend (normalize-row names-and-values (schema table)) (rows table))
)


(defun normalize-row (names-and-values schema)
  (loop
     for column in schema
     for name  = (name column)
     for value = (or (getf names-and-values name) (default-value column))
     collect name
     collect (normalize-for-column value column)
)
)

Создание дополнительной функции normalize-for-column, которая получает значение, и объект column и возвращает нормализованное значение, оправдано тем, что вам будет проводить нормализацию значений при запросах к таблице.

(defun normalize-for-column (value column)
  (funcall (value-normalizer column) value column)
)

Теперь вы готовы к объединению кода базы данных с кодом из предыдущих глав, чтобы построить базу данных, содержащую информацию выделенную из файлов MP3. Вы можете определить функцию file->row, которая будет использовать функцию read-id3 из библиотеки ID3v2 для выделения тагов ID3 из файла, и превращения их в список свойств, который будет передан функции insert-row.

(defun file->row (file)
  (let ((id3 (read-id3 file)))
    (list
     :file   (namestring (truename file))
     :genre  (translated-genre id3)
     :artist (artist id3)
     :album  (album id3)
     :song   (song id3)
     :track  (parse-track (track id3))
     :year   (parse-year (year id3))
     :id3-size (size id3)
)
)
)

Вам не нужно беспокоиться о нормализации значений, поскольку это будет сделано в insert-row. Однако, вы должны сконвертировать строки, возвращенные функциями track и year в числа. Число track (номер композиции) – это таг ID3, который иногда сохраняется как число в виде строки, и иногда как число, за которым следует (через знак слеш) еще одно число, обозначающее количество композиций в альбоме. Поскольку нам нужен только номер композиции, то вы должны использовать аргумент :end при вызове функции PARSE-INTEGER для того, чтобы указать что разбор должен осуществляться только до знака слеш, если он есть.3)

(defun parse-track (track)
  (when track (parse-integer track :end (position #\/ track)))
)


(defun parse-year (year)
  (when year (parse-integer year))
)

В заключение, вы можете собрать все эти функции вместе с walk-directory из библиотеки переносимых имен файлов, а также функцией mp3-p из библиотеки ID3v2 чтобы определить функцию, которая загружает в базу данных MP3 информацию извлеченную из файлов MP3, которые были найдены в определенном каталоге (и всех его подкаталогах).

(defun load-database (dir db)
  (let ((count 0))
    (walk-directory
     dir
     #'(lambda (file)
         (princ #\.)
         (incf count)
         (insert-row (file->row file) db)
)

     :test #'mp3-p
)

    (format t "~&В базу данных загружено ~d файлов." count)
)
)

Выполнение запросов к базе данных

После того, как загрузите данные в базу данных, вам необходимо найти способ выполнять запросы к ней. Для приложения работающего с файлами MP3 вам понадобятся более сложные функции выполнения запросов чем те, которые были использованы в главе 3. Сейчас вам нужна не только возможность извлекать строки отвечающие определенным критериям, но также и возможность делать выборку только определенных колонок, и возможно, сортировать строки по определенной колонке. В соответствии с теорией реляционных баз данных, результатом запроса будет новая таблица, содержащая строки и колонки.

В качестве образца для функции выполнения запросов – select , был взят оператор SELECT из языка SQL. Эта функция принимает пять именованных параметров: :from, :columns, :where, :distinct и :order-by. Аргумент :from указывает объект table для которого вы хотите выполнить запрос. Аргумент :columns указывает то, какие колонки должны быть включены в результат. В качестве значения должен быть указан список имен колонок, имя одной колонки или T (значение по умолчанию), указывающее, что должны быть включены все колонки. Аргумент :where (если он указан), должен быть функцией, которая получает строку, и возвращает истинное значение, если эта строка должна быть включена в результаты. Немного спустя, вы напишете две функции – matching и in, которые возвращают функции, допустимые для использования в качестве аргумента :where. Аргумент :order-by (если он указан), должен быть списком имен колонок; результаты будут отсортированы по соответствующим колонкам. Также как и для аргумента :columns, вы можете указать лишь одну колонку, просто используя ее имя, что эквивалентно списку из одного элемента. В заключение, аргумент :distinct является логическим значением, которое указывает – должны ли мы удалять дублирующиеся строки из результата. Значением по умолчанию для :distinct является NIL.

Вот несколько примеров использования select:

;; Выбрать все строки где колонка :artist равна "Green Day"
(select :from *mp3s* :where (matching *mp3s* :artist "Green Day"))

;; Получить отсортированный список артистов, исполняющих песни в жанре "Rock"
(select
  :columns :artist
  :from *mp3s*
  :where (matching *mp3s* :genre "Rock")
  :distinct t
  :order-by :artist
)

Реализация select вместе со вспомогательными функциями выглядит примерно так:

(defun select (&key (columns t) from where distinct order-by)
  (let ((rows (rows from))
        (schema (schema from))
)


    (when where
      (setf rows (restrict-rows rows where))
)


    (unless (eql columns 't)
      (setf schema (extract-schema (mklist columns) schema))
      (setf rows (project-columns rows schema))
)


    (when distinct
      (setf rows (distinct-rows rows schema))
)


    (when order-by
      (setf rows (sorted-rows rows schema (mklist order-by)))
)


    (make-instance 'table :rows rows :schema schema)
)
)


(defun mklist (thing)
  (if (listp thing) thing (list thing))
)


(defun extract-schema (column-names schema)
  (loop for c in column-names collect (find-column c schema))
)


(defun find-column (column-name schema)
  (or (find column-name schema :key #'name)
      (error "No column: ~a in schema: ~a" column-name schema)
)
)


(defun restrict-rows (rows where)
  (remove-if-not where rows)
)


(defun project-columns (rows schema)
  (map 'vector (extractor schema) rows)
)


(defun distinct-rows (rows schema)
  (remove-duplicates rows :test (row-equality-tester schema))
)


(defun sorted-rows (rows schema order-by)
  (sort (copy-seq rows) (row-comparator order-by schema))
)

Конечно, самыми интересными частями select является реализация функций extractor, row-equality-tester и row-comparator.

Как вы можете заключить из того, как эти функции используются, каждая из этих функций должна возвращать новую функцию. Например, функция project-columns использует значение, возвращенное функцией extractor в качестве аргумента функции MAP. Поскольку project-columns предназначена для возврата набора строк с только определенными значениями колонок, вы можете заключить, что extractor возвращает функций, которая получает строку в качестве аргумента, и возвращает новую строку, которая содержит только колонки, указанные в переданной ей схеме. Вот как мы можем реализовать эту функцию:

(defun extractor (schema)
  (let ((names (mapcar #'name schema)))
    #'(lambda (row)
        (loop for c in names collect c collect (getf row c))
)
)
)

Отметьте то, как вы можете выполнить задачу по извлечению имен из схемы за пределами тела замыкания – поскольку замыкание может быть вызвано несколько раз, вы захотите чтобы в нем выполнялось как можно меньше действий при каждом вызове.

Функции row-equality-tester и row-comparator реализуются аналогичным образом. Для того, чтобы принять решение о равенстве двух строк, вам необходимо применить соответствующие функции сравнения каждой из колонок к значениям соответствующих колонок. Из материала главы 22 мы знаем, что LOOP всегда возвращает NIL когда пара значений не проходит тест, в противном случае LOOP вернет T.

(defun row-equality-tester (schema)
  (let ((names (mapcar #'name schema))
        (tests (mapcar #'equality-predicate schema))
)

    #'(lambda (a b)
        (loop for name in names and test in tests
           always (funcall test (getf a name) (getf b name))
)
)
)
)

Расположение двух строк по порядку – более сложная задача. В Lisp функции сравнения возвращают истинное значение, если первый аргумент должен быть расположен перед вторым аргументом, или NIL в противном случае. Таким образом, NIL может означать, что второй аргумент должен быть расположен перед первым аргументом, или оба аргумента равны. Мы также хотим, чтобы функции сравненпия строк вели себя точно также – возвращали T если первая строка должна быть перед второй, и NIL в противном случае.

Таким образом, для сравнения двух строк, вы должны сравнить значения тех колонок, по которым вы будете проводить сортировку, используя соответствующую функцию сравнения для каждой из колонок. Сначала вызывается функция сравнения со значением из первой строки в качестве первого аргумента. Если функция сравнения вернет истинное значение, то это означает, что первая колонка точно должна распологаться перед второй колонкой, так что вы можете сразу вернуть значение T.

Но если функция сравнения вернула NIL, то вам нужно определить почему это произошло – либо второе значение должно быть поставлено перед первым, или они равны. Так что вам необходимо снова вернуть функцию сравнения, но поменять аргументы местами. Если функция сравнения вернет истинное значение, то это означает, что вторая строка должна стоять перед первой, и вы можете сразу вернуть NIL. В противном случае, значения в данной колонке равны, и вам необходимо перейти к следующей колонке. Если вы проверите все колонки и не получите однозначного сравнения в пользу одной из строк, то эти строки равны, и вы должны вернуть NIL. Функция, которая реализует такой алгоритм, будет выглядеть следующим образом:

(defun row-comparator (column-names schema)
  (let ((comparators (mapcar #'comparator (extract-schema column-names schema))))
    #'(lambda (a b)
        (loop
           for name in column-names
           for comparator in comparators
           for a-value = (getf a name)
           for b-value = (getf b name)
           when (funcall comparator a-value b-value) return t
           when (funcall comparator b-value a-value) return nil
           finally (return nil)
)
)
)
)

Функции отбора (FIXME Matching)

Аргумент :where функции select может быть любой функцией, которая принимает в качестве аргумента строку и возвращает истинное значение, если она должна быть включена в результаты. Однако на практике, вам редко понадобится вся мощь вручную написанного кода для выражения критериев запроса. Так что вы должны лишь реализовать две функции: matching и in, которые будут создавать функции запроса, которые позволят вам создавать общие виды запросов, а также возьмут на себя заботу об использовании соответствующих функций равенства и нормализации для каждой из колонок.

FIXME The workhouse query-function constructor will be функция matching, которая возвращает функцию, которая будет сравнивать строку с конкретными значениями колонок. Вы увидели как она может быть использована в предыдущих примерах select. Например, такой вызов matching:

(matching *mp3s* :artist "Green Day")

вернет функцию, которая будет выбирать строки, в которых значение колонки :artist равно "Green Day". Вы также можете передавать множество имен колонок и значений – возвращаемая функция будет возвращать истинное значение только тогда, когда все колонки имеют заданные значения. Например, следующий вызов вернет замыкание, которое будет принимать строки, в которых артист равен "Green Day" и альбом равен "American Idiot":

(matching *mp3s* :artist "Green Day" :album "American Idiot")

Вам необходимо передать функции matching объект table, поскольку функции необходим доступ к схеме таблицы для получения функций сравнения и нормализации для тех колонок, для которых выполняется отбор данных.

Вы строите функцию, возвращаемую функцией matching из меньших функций, каждая из которые отвечает за проверку значения одной из колонок. Для того, чтобы создать эти функции, вы должны определить функцию column-matcher, которая получает объект column и не нормализованное значение и возвращает функцию, которая получает строку и возвращает истинное значение в том случае, если значение заданной колонки соответствует нормализованному значению заданного аргумента.

(defun column-matcher (column value)
  (let ((name (name column))
        (predicate (equality-predicate column))
        (normalized (normalize-for-column value column))
)

    #'(lambda (row) (funcall predicate (getf row name) normalized))
)
)

Затем вы создаете список функций column-matching для заданных имен и значений, переданных функции column-matchers:

(defun column-matchers (schema names-and-values)
  (loop for (name value) on names-and-values by #'cddr
     when value collect
       (column-matcher (find-column name schema) value)
)
)

Теперь вы можете реализовать matching. Снова, заметьте, что вы делаете как можно больше работы за пределами замыкания, чтобы выполнить эти операции один раз при создании замыкания, а не при его вызове для каждой из строк таблицы.

(defun matching (table &rest names-and-values)
  "Build a where function that matches rows with the given column values."
  (let ((matchers (column-matchers (schema table) names-and-values)))
    #'(lambda (row)
        (every #'(lambda (matcher) (funcall matcher row)) matchers)
)
)
)

Эта функция выглядит как небольшой клубок замыканий, но стоит пристальней посмотреть на нее для того, чтобы получить "наслаждение" (FIXME flavor) от возможности программирования с функциями как объекты первого класса(FIXME?)

Задачей matching является возврат функции, которая будет выполняться для каждой строки в таблице для того, чтобы определить – должна ли эта строка быть включена в результат, или нет. Так что функция matching возвращает замыкание принимающее один параметр – строку row.

Теперь вспомните, что функция EVERY принимает фунцию-предикат в качестве первого аргумента, и возвращает истинное значение, только если функция будет возвращать истинное значение для каждого из элементов списка, который передан EVERY в качестве второго аргумента. Однако, в нашем случае список, переданный EVERY является списком функций – функций отбора для конкретных колонок. Все что вам нужно знать – это то, что каждая функция отбора колонки, при запуске для строки, для которой вы проводите проверку, возвращает истинное значение. Так что в качестве функции-предиката для EVERY вы передаете еще одно замыкание, которое применит FUNCALL к функции отбора колонки, передав ей параметр row.

Другой полезной функцией отбора является in, которая возвращает функцию, которая отбирает строки, где значение определенной колонки входит в заданный набор значений. Функция in будет принимать два аргумента – имя колонки, и таблицу, которая содержит значения, с которыми вы будете сравнивать. Предположим, например, что вы хотите найти все песни в базе данных MP3, у которых названия совпадают с названиями песен исполняемых Dixie Chicks. Вы можете написать это выражение where используя функцию in и вспомогательный запрос, например, вот так:4)

(select
  :columns '(:artist :song)
  :from *mp3s*
  :where (in :song
             (select
               :columns :song
               :from *mp3s*
               :where (matching *mp3s* :artist "Dixie Chicks")
)
)
)

Хотя запросы более сложные, но реализация in намного проще чем реализация matching.

(defun in (column-name table)
  (let ((test (equality-predicate (find-column column-name (schema table))))
        (values (map 'list #'(lambda (r) (getf r column-name)) (rows table)))
)

    #'(lambda (row)
        (member (getf row column-name) values :test test)
)
)
)

Работа с результатами выполнения запросов

Поскольку select возвращает другую таблицу, вам необходимо немного подумать о том, как вы будете осуществлять доступ к отдельным значениям. Если вы уверены, что вы никогда не измените способ представления данных в таблице, то вы можете просто сделать структуру таблицы частью API и указать, что класс table имеет слот rows который является вектором содержащим списки свойств, и для доступа к данным в таблице использовать стандартные функции Common Lisp для работы с векторами и списками свойств. Но представление данных – это внутренняя деталь, которую вы можете захотеть изменить. Также вы можете не захотеть, чтобы другие разработчики напрямую работали с данными, например, вы можете захотеть, чтобы никто не мог с помощью SETF вставить в строку ненормализованное значение. Так что хорошей идеей может быть определение нескольких абстракций, которые будут обеспечивать нужные вам операции. Так что, если вы захотите изменить внутреннее представление данных, то вам нужно будет изменить только реализацию этих функций и макросов. И хотя Common Lisp не позволяет вам полностью запретить доступ к "внутренним" данным, путем предоставления официального API вы по крайней мере сможете указать где проходит граница, разграничивающая внешнее и внутреннее представление.

Вероятно, наиболее часто используемой операцией с результатами запроса будет итерация по отдельным строкам, и выделение значений конкретных колонок. Так что вам нужно предоставить возможность для выполнения эти операций без прямого доступа к вектору строк или использования GETF для получения значения колонки внутри строки.

Реализация этих операция является тривиальной – эти функции являются лишь врапперами вокруг кода, который бы вы написали, если у вас не было этих абстракций. Вы можете предоставить два способа итерации по строкам таблицы: макрос do-rows, который обеспечивает базовый способ организации циклов, и функцию map-rows, которая создает список, содержащий результаты применения заданной функции к каждой строке таблицы.5)

(defmacro do-rows ((row table) &body body)
  `(loop for ,row across (rows ,table) do ,@body)
)


(defun map-rows (fn table)
  (loop for row across (rows table) collect (funcall fn row))
)

Для получения значения конкретной колонки внутри строки, вы должны реализовать функцию column-value, которая будет принимать в качестве аргументов строку таблицы и название колонки, и будет возвращать соответствующее значение. Опять же, это лишь тривиальный враппер вокруг кода, который бы вы и так написали. Но если вы позже измените внутреннее представление данных, то пользователи column-value не будут об этом знать.

(defun column-value (row column-name)
  (getf row column-name)
)

Хотя column-value является достаточной абстракцией доступа к значениям колонок, вам достаточно часто нужно получать одновременный доступ к значениям сразу нескольких колонок. Так что мы реализуем макрос with-column-values, который будет связывать набор переменных со значениями извлеченными из строки используя соответствующие именованные параметры. Так что вместо использования такого кода:

(do-rows (row table)
  (let ((song (column-value row :song))
        (artist (column-value row :artist))
        (album (column-value row :album))
)

    (format t "~a by ~a from ~a~%" song artist album)
)
)

вы можете просто написать следующим образом:

(do-rows (row table)
  (with-column-values (song artist album) row
    (format t "~a by ~a from ~a~%" song artist album)
)
)

И снова, реализация не является очень сложной, если вы используете макрос once-only из главы 8.

(defmacro with-column-values ((&rest vars) row &body body)
  (once-only (row)
    `(let ,(column-bindings vars row) ,@body)
)
)


(defun column-bindings (vars row)
  (loop for v in vars collect `(,v (column-value ,row ,(as-keyword v))))
)


(defun as-keyword (symbol)
  (intern (symbol-name symbol) :keyword)
)

И в заключение, вы должны предоставить функции для получения количества строк в таблице, а также для доступа к конкретной строке используя числовой индекс.

(defun table-size (table)
  (length (rows table))
)


(defun nth-row (n table)
  (aref (rows table) n)
)

Другие операции с базой данных

И в заключение, вы реализуете несколько дополнительных операций с базой данных, которые будут использованы в главе 29. Первые две из них являются аналогами выражения DELETE языка SQL. Функция delete-rows используется для удаления из таблицы строк, соответствующих некоторому критерию. Также как и select она принимает именованные аргументы :from и :where. Но в отличии от select, эта функция не возвращает новую таблицу – вместо этого, она изменяет таблицу, переданную в качестве аргумента the :from.

(defun delete-rows (&key from where)
  (loop
     with rows = (rows from)
     with store-idx = 0
     for read-idx from 0
     for row across rows
     do (setf (aref rows read-idx) nil)
     unless (funcall where row) do
       (setf (aref rows store-idx) row)
       (incf store-idx)
     finally (setf (fill-pointer rows) store-idx)
)
)

В интересах повышения производительности, вы можете также реализовать отдельную функцию для удаления всех строк из таблицы.

(defun delete-all-rows (table)
  (setf (rows table) (make-rows *default-table-size*))
)

Оставшиеся функции для работы с базой данных не имеют аналогов среди операций с реляционными базами данных, но они будут полезны при написании приложения использующего базу данных MP3. Первой среди них является функция, которая сортирует строки таблицы изменяя ее.

(defun sort-rows (table &rest column-names)
  (setf (rows table) (sort (rows table) (row-comparator column-names (schema table))))
  table
)

С другой стороны, в приложении, работающем с базой данных MP3, вам может понадобиться функция, которая перемешивает строки в таблице, используя функцию nshuffle-vector из главы 23.

(defun shuffle-table (table)
  (nshuffle-vector (rows table))
  table
)

И в заключение, снова для приложения работающего с базой данных MP3, вы должны реализовать функцию которая будет выбирать N произвольных строк, возвращая результат в виде новой таблицы. Эта функция также использует nshuffle-vector вместе с версией random-sample, основанной на Алгоритме S из книги "Искусство программирования, т.2. Получисленные алгоритмы, 3 изд." Дональда Кнута, и который мы обсуждали в главе 20.

(defun random-selection (table n)
  (make-instance
   'table
   :schema (schema table)
   :rows (nshuffle-vector (random-sample (rows table) n))
)
)


(defun random-sample (vector n)
  "Based on Algorithm S from Knuth. TAOCP, vol. 2. p. 142"
  (loop with selected = (make-array n :fill-pointer 0)
     for idx from 0
     do
       (loop
          with to-select = (- n (length selected))
          for remaining = (- (length vector) idx)
          while (>= (* remaining (random 1.0)) to-select)
          do (incf idx)
)

       (vector-push (aref vector idx) selected)
     when (= (length selected) n) return selected
)
)

Имея данный код, вы будете готовы создать (в главе 29) веб-интерфейс для просмотра коллекции файлов в формате MP3. Но до этого вам необходимо реализовать часть сервера, которая будет транслировать поток музыки в формате MP3 используя протокол Shoutcast, что и является темой следующей главы.

1)Общим основанием для интернирования объектов явялется то, что когда вам нужно сравнивать определенное значение много раз, то стоит выполнит его интернирование, несмотря на некоторые затраты на эту операцию. Функцияvalue-normalizer запускается один раз когда вы вставляете значение, и как вы увидите далее, один раз в начале каждого запроса. Поскольку запрос может приводить к выполнению equality-predicate для каждой из строк таблицы, то общие затраты на интернирование значений, быстро приближаются к нулю.
2)Как всегда, в книгах по программированию правильная обработка ошибок является поводом для сокращения; при разработке в реальных условиях, вы скорее всего определите специальный тип ошибки, и будете использовать его, вместо стандартного:
(error 'illegal-column-value :value value :column column)
Затем вы можете подумать о том, где вы можете добавить код перезапуска, который позволит вам восстановить последствия такой ошибки. И в заключение, в почти любом приложении, вы должны установить обработчики событий, которые позволят выбрать соответствующий код перезапуска.
3)Если какой-то из файлов MP3 содержит неправильные данные в записях track и year, то PARSE-INTEGER может сигнализировать об ошибке. Одним из способов обойти это поведение – передать функции PARSE-INTEGER параметр :junk-allowed равный T, который заставит функцию игнорировать любой "мусор", который следует за числом, и вернуть NIL если чисо не было найдено в строке. Или, если вы хотите попрактиковаться в использовании системы условий и перезапусков, то вы можете определить специальное значение error и использовать его в качестве сигнала из этих функций, в том случае если данные неправильно оформлены, а также установить несколько точек перезапуска, чтобы позволить этим функциям обработать эти ошибки.
4)Этот запрос также вернет вам все песни исполненяемые Dixie Chicks. Если вы захотите ограничить этот запрос, чтобы он содержал только артистов, отличных от Dixie Chicks, то вам нужна более сложная функция :where. Поскольку аргументом :where может быть любая функция, то это можно сделать; вы можете удалить собственные песни Dixie Chicks' с помощью вот такого запроса:
(let* ((dixie-chicks (matching *mp3s* :artist "Dixie Chicks"))
       (same-song (in :song (select :columns :song :from *mp3s* :where dixie-chicks)))
       (query #'(lambda (row) (and (not (funcall dixie-chicks row))
                                   (funcall same-song row)
)
)
)
)

  (select :columns '(:artist :song) :from *mp3s* :where query)
)

Однако это не особо удобно. Если вы пишете приложение, которому требуется выполнять много сложных запросов, то вы можете захотеть придумать более выразительный язык запросов.
5)Версия LOOP реализованная в M.I.T. до стандартизации Common Lisp включала механизм для расширения грамматики LOOP, которые бы позволяли реализовывать итерацию по новым структурам данных. Некоторые реализации Common Lisp, которые унаследовали эту реализацию LOOP, могут до сих пор иметь эту возможность, что делает do-rows и map-rows не особо нужными.
Предыдущая Оглавление Следующая
@2009-2013 lisper.ru