Как самому сделать или навести порядок в своей электронной библиотеке

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

Этот пример работает на языках ANSI Common Lisp)

• clisp
• sbcl
• gcl27 (в режиме ANSI) -- не проверялся

Принцип работы программы

Принцип реализован на сохранении кратких справочных данныхо каждой книге путем сканирования каталогов в электронной библиотеке первый раз. Данные сохраняются. Больше сканировать нет небходимости.

В дальнейшем программа сама сразу открывает нужную книгу.

Листинг файла программы

;;; todo
#!/usr/bin/clisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; load
(load "~/dev/lisp/pac/c-string.lisp")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; #ifndef kartoteka
(setf version "make-kartoteka version: 0.12.5")
;(setf *debug* t)
(setf *debug* nil)
(defun print-obj ( o &optional s )
  (when *debug* 
     (terpri)
     (prin1 (type-of s))
     (prin1 #:)
     (prin1 s)

     
     (terpri)
     (prin1 (type-of o))
     (prin1 #:)
     (prin1 o)
     (terpri))
      o)
;;;; #endif
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; define vars
;;;;

     
(defvar *db*         (list))
(defvar *filetype*   (list))
(defvar *author*     )
(defvar *udk*        )
(defvar *bbk*        )
(defvar *isbn*       )
(defvar *title*      )
(defvar *annotation* )
(defvar *ocr* )
(defvar *filename* )
(defvar *filepath* )
(defparameter  *list-buch*  "inc/data.l")
(defparameter *input-path* "buch1/")
(defvar *author-arg*     (list))

     
(defvar *udk-arg*        (list))
(defvar *bbk-arg*        (list))
(defvar *isbn-arg*       (list))
(defvar *title-arg*      (list))
(defvar *annotation-arg* (list))
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Структура книги
;;;;
(defun viewb( o stream ) 
  "печать на терминал"
  (format stream
          "~%ББК ~a~%УДК ~a~%~a~%~a~%     ~a~%ISBN ~a~%ocr ~a,~%filepath ~a/~a.~a~% "

     
          (b-bbk o) (b-udk o) (b-author o) (b-title o) (b-annotation o) (b-isbn o) (b-ocr o) (b-filepath o) (b-filename o) (b-filetype o) 
          ))

(defun viewf( o stream ) 

  "вывод в файл для read"
  (format stream
    "(:bbk "~a"
    :udk "~a"
    :author "~a"
    :title "~a"
    :annotation "~a"
    :isbn "~a"
    :ocr "~a"
    :filename "~a"
    :filetype "~a"

     
    :filepath "~a" )~%" 
          (b-bbk o) (b-udk o) (b-author o) (b-title o) (b-annotation o)
          (b-isbn o) (b-ocr o) (b-filename o) (b-filetype o) (b-filepath o) 
                    ))

(defun viewp (o stream)
  (format stream "~{~{~a:~10t~a~%~}~%~}~%" o))
    

     
(defun viewd (o stream)
  (dolist (v o)
    (format stream "~{~a:~10t~a~%~}~%" v)))
    
(defun viewl (o stream)
    (format stream "~{~{~a:~10t~a~%~}~}~%" o))
    

(defstruct (buch (:conc-name b-))
                 ;(:print-function viewb) 
                 ;(:print-function viewf)
                 ;(:print-function viewp))
                  

     
                 bbk
                 udk
                 author
                 title
                 annotation
                 isbn
                 (ocr t)
                 filename
                 filetype
                 filepath
                 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Процедуры 
;;;;

     
(defun txt->bz2 (&optional (rewr nil))
  "Создаёт/добавляет новую базу данных книг"
    ;(setf dir (directory (c:strcat *input-path* "*.txt")))
    (setf dir (directory (concatenate 'string *input-path* "*.txt")))
    (print-obj dir)) 
;;;;
(defun create-p-buch ()
        (make-buch
                   :bbk *bbk*
                   :udk *udk*
                   :author *author*
                   :title *title*
                   :annotation *annotation*

     
                   :isbn *isbn*
                   :ocr *ocr*
                   :filepath *filepath*
                   :filename *filename*
                   :filetype *filetype*
                   ))
  ;(viewb p t)
  ;(viewf p t)
  ;(viewp p t)
  
;;;
(defun write-buch-list-new ()
  "Создаёт на диске новый список книг, старый--переименовывает"
  (print-obj " ---=== write-buch-list-new ===---")
  (setf path *list-buch*)
  (with-open-file (str path :direction :output
                          :if-exists :rename)

     
                          ;:if-exists :supersede)
  ;(with-open-file (str path :direction :output
                          ;:if-does-not-exist :create
                          ;:if-exists :append)
    ;(print-obj "with-open-file")
    ;(print-obj *db*)
    (with-standard-io-syntax
      (print *db* str))))
;;;
(defun write-buch-list-add ()
  "Создаёт на диске новый список книг, старый--удаляет"
  (print-obj " ---=== write-buch-list-add ===---")
  (setf path *list-buch*)
  (with-open-file (str path :direction :output
                          :if-exists :supersede)

     
  ;(with-open-file (str path :direction :output
                          ;:if-does-not-exist :create
                          ;:if-exists :append)
    ;(print-obj "with-open-file")
    ;(print-obj *db*)
    (with-standard-io-syntax
      (print *db* str))))
;;;
(defun read-buch-list ()
  "Читает с диска список книг"
  (setf path *list-buch*)
  (print-obj " ---=== start read-buch-list ===---")
  (with-open-file (str path :direction :input)

     
    ;(do ((object1 (read str nil `eof)
          ;(read str nil `eof)))
        ;((eql object1 `eof))
        (with-standard-io-syntax
          (setf *db* (read str))))
  ;(print-obj *db*)
  (print-obj " ---=== end read-buch-list ===---")
  )

     
  ;)
;;;
(defun read-buch-txt ( file )
  "Создаёт из файла типа txt элементы книги в глобальных переменных"
  (print-obj " ---=== start read-buch-txt ===---" )
  (with-open-file (str file :direction :input)
    (do ((w (read-line str nil :eof) (read-line str nil :eof))
         (j 0 (+ j 1)) (len-aut 50) (len-tit 170) (len-ann 170)
         (n) (au))
        ((or (or (= j 15 ) (eql w :eof)) (> (length w) len-ann))
         (print-obj "*annotation*:") (print-obj (setf *annotation* w))
         (if (eql w :eof)

     
           (setf *annotation* " ")
           (setf *annotation* w)))
        (print-obj j)
        (print-obj w)
          (unless (> 5 (length w))
            (print-obj "(> 5 (length w)")
            ;(when (setf n (c:strstr w "ocr"))
            (when (setf n (search "ocr" w :test #'string-equal))
              (print-obj "*ocr*:")
              (setf *ocr* (c:strcpy w :start (+ 4 n) ))
              (print-obj *ocr*))
            ;(when (setf n (c:strstr w "ББК"))
            (when (setf n (search "ББК" w :test #'string-equal))
              (print-obj "*bbk*:")

     
              (push (c:strcpy w :start (+ 4 n) ) *bbk*)
              (print-obj *bbk*))
            ;(when (setf n (c:strstr w "УДК"))
            (when (setf n (search "УДК" w :test #'string-equal))
              (print-obj "*udk*:")
              (push (c:strcpy w :start (+ 4 n) ) *udk*)
              (print-obj *udk* ))
            ;(when (setf n (c:strstr w "ISBN"))
            (when (setf n (search "ISBN" w :test #'string-equal))
              (print-obj "*isbn*:")
              (setf *isbn* (c:strcpy w :start (+ 4 n) ))
              (print-obj *isbn*))
            (when (< (length w) len-aut)
              ;(unless (c:strstr w "ББК")
              (unless (search "ББК" w :test #'string-equal)
                ;(unless (c:strstr w "УДК")
                (unless (search "УДК" w :test #'string-equal)

     
                  ;(unless (c:strstr w "ISBN")
                  (unless (search "ISBN" w :test #'string-equal)
                    ;(unless (c:strstr w "OCR")
                    (unless (search "OCR" w :test #'string-equal)
                     (print-obj "*author*:")
                     ;(setf *author* w)
                     ;(if (c:strstr w ",")
                     (if (position #, w :end (- (length w) 2))
                       (progn
                         (print-obj w "w")
                         (setf au (c:strspl w ","))
                         (dolist (v au)
                            (push v *author*))
                            (print-obj *author* ))
                       (push w *author*))
                     (print-obj *author* ))))))
            (if (or (search ":tit" w :test #'string-equal)
                    (and (> (length w) len-aut)

     
                         (< (length w) len-tit)))
              (setf *title* w))
            (if (or (search ":ann" w :test #'string-equal)
                      (> (length w) len-ann))
              (setf *annotation* w))
          )
        ))
        ;(print-obj "*filepath*:")
        ;(print-obj *filepath*)
        (print-obj file "file:")
        (print-obj (setf *filepath* (pathname-directory file) ) "*filepath*:")
        ;(print-obj (setf *filepath* *input-path* ) "*filepath*:")
        (print-obj (setf *filename* (pathname-name file) ) "*filename*:")

     
        ;(stop)
        ;(print-obj "*filetype*:")
        ;(print-obj *filetype*)
        (print-obj " ---=== end read-buch-txt ===---")
  )
;;;  
(defun clear-var ()
  (setf *bbk* nil) (setf *udk* nil) (setf *isbn* nil) (setf *ocr* t)
  (setf *annotation* nil) (setf *author* nil) (setf *title* nil) 
  (setf *filepath* nil) (setf *filetype* nil) (setf *filename* nil))
;;;
(defun xml-tag-del ( string tag &optional integer )

     
  "Возвращает внутренность первого тэга xml (
123
: '123')"
  (print-obj " ---=== start xml-tag-del ===---" )
  (print-obj string "string")
  ;(setf tag-start (c:strcat "<" (c:strcat tag ">")))
  (setf tag-start (concatenate 'string "<" tag ">"))
  (print-obj tag-start "tag-start")
  ;(setf tag-end (c:strcat "")))
  (setf tag-end (concatenate 'string ""))
  (print-obj tag-end "tag-end")
  ;(setf tag-empty (c:strcat "<" (c:strcat tag "/>")))
  (setf tag-empty (concatenate 'string "<" tag "/>"))
  ;(if (c:strstr string tag-empty)
    ;(setf c-str " ")
    ;(progn

     
      ;(c:strtok-c-start string tag-start)
      ;(setf c-str (c:strtok-c-next string tag-end))))
  ;(print-obj c-str 'c-str))
  ;(if (c:strstr string tag-empty)
  (if (search  tag-empty string :test #'string-equal)
    (setf c::*str!* " ")
    (progn
      (c:strtok-c-start string tag-start)
      (setf c::*str!* (c:strtok string tag-end))
      (setf out (c:strtok c::*str!* tag-start))))
  c::*str!*)
;;;
(defun read-buch-fb2 ( file )
  "Создаёт из файла типа fb2 элементы книги в глобальных переменных"
  (declare (special fb2-))
  (declare (special a))
  (declare (special author))

     
  (print-obj " ---=== start read-buch-fb2 ===---" )
  (print-obj file 'file )
  (with-open-file (str file :direction :input)
                       ;:external-format "WINDOWS-1251")
    (setf fb2- (let ((buf (make-string 128)) )
                   (read-sequence buf str )
                   buf)))
  (print-obj fb2- "fb2-")
  ;(if (c:strstr fb2- "1251")
  (if (search "1251" fb2- :test #'string-equal)
    (with-open-file (str file :direction :input
                       :external-format "WINDOWS-1251")
      (setf fb2- (let ((buf (make-string 4096)) )
                   (read-sequence buf str )
                   buf)))
    (with-open-file (str file :direction :input)

     
      (setf fb2- (let ((buf (make-string 4096)) )
                   (read-sequence buf str )
                   buf))))
  (print-obj fb2- "fb2-")
  ;(setf *author*
    ;(let* ((aut-f (xml-tag-del (xml-tag-del fb2- "author") "last-name"))
      ;(aut-n (xml-tag-del (xml-tag-del fb2- "author") "first-name")))
      ;(c:strcat aut-f (c:strcat " " aut-n))))
  (setf author
        (c:strspl fb2- "author>"))
  (print-obj author "author")
  (pop author)
  (dolist (v author)
    ;(when (c:strstr v "last-name")

     
    (when (search "last-name" v :test #'string-equal)
      (setf a
          (let* ((aut-f (xml-tag-del v "last-name"))
                 (aut-n (xml-tag-del v "first-name")))
                 (concatenate 'string aut-f " " aut-n))))
      (push a *author*)
      (print-obj a "a")
      (print-obj *author* "*author*"))

  ;(nreverse *author*)
  ;(pop *author*)
  (print-obj *author* "*author*")
  ;(stop)
  (setf *title*
    (let* ((tit (xml-tag-del fb2- "book-title") )
      (cit (xml-tag-del (xml-tag-del fb2- "publish-info") "city"))
      (pub (xml-tag-del (xml-tag-del fb2- "publish-info") "publisher"))

     
      (yea (xml-tag-del (xml-tag-del fb2- "publish-info") "year")))
      ;(tt (c:strcat tit (c:strcat " " cit)))
      ;(p (c:strcat pub (c:strcat " " yea))))
      ;(c:strcat tt (c:strcat " " p))))
      (concatenate 'string tit " " cit " " pub " " yea)))
  (when (> (length *title*) 170)
    (setf *title* (xml-tag-del fb2- "book-title")))
  (print-obj *title* "*title*")
  (setf *isbn* 
        ;(if (c:strstr fb2- "isbn")
        (if (search "isbn" fb2- :test #'string-equal)
          (xml-tag-del fb2- "isbn")
          nil))
  (print-obj *isbn* "*isbn*")

     
  (setf *annotation* 
        ;(if (c:strstr fb2-  "annotation")
        (if (search "annotation" fb2- :test #'string-equal)
          (xml-tag-del fb2- "annotation")
          nil))

  (print-obj *annotation* "*annotation*")

  ;(break "это break")

  (print-obj (setf *filepath* (pathname-directory file) ) "*filepath*:")
  ;(print-obj (setf *filepath* *input-path* ) "*filepath*:")
  (print-obj (setf *filename* (pathname-name file) ) "*filename*:")
  (print-obj " ---=== end read-buch-fb2 ===---")
  

     
  ;(break loop)
  ;(stop)
  )
;;;
(defun create-buch-list()
  "Создаёт книгу из глобальных переменных и добавляет её к списку книг"
    (do ((j (length str-name) (- j 1)))
        ((or (= j 0) (eql str-name :eof)))
        (print-obj str-name)
        (setf a (pop str-name))
        (print-obj a)
        (setf b (pathname-type a))
        (print-obj b)
        (when (equal b "fb2")
          (push "fb2" *filetype*)
          (print-obj *filetype*)

     
          ;(setf c (c:strcat *input-path* a))
          (setf c (concatenate 'string *input-path* a))
          (read-buch-fb2 c)
          (push (create-p-buch) *db* )
          (clear-var))
        (when (equal b  "pdf")
          (push "pdf" *filetype* )
          (print-obj *filetype*))
        (when (equal b "djvu")
          (push "djvu" *filetype*)
          (print-obj *filetype*))
        (when (equal b "html")
          (push "html" *filetype*)
          (print-obj *filetype*))
        (when (equal b "htm")
          (push "htm" *filetype*)
          (print-obj *filetype*))
        (when (equal b "tar")
          (push "tar" *filetype*)
          (print-obj *filetype*))
        (when (equal b "txt")

     
          (push "txt" *filetype*)
          (print-obj *filetype*)
          ;(setf c (c:strcat *input-path* a))
          (setf c (concatenate 'string *input-path* a))
          (read-buch-txt c)
          (push (create-p-buch) *db* )
          (clear-var))
))
;;;;
(defun create-new-db (&optional (rewr nil))
  "Создаёт/добавляет новую базу данных книг"
    ;(setf dir (directory (c:strcat *input-path* "*")))
    (setf dir (directory (concatenate 'string  *input-path* "*")))
    (print-obj dir) 
    (setf str-name '())
    (dolist (var dir)

     
      (setf str (file-namestring var))
      (push str str-name))
    (setf str-name (sort str-name #'string<))
    (print-obj str-name)
    ;;
    (clear-var)
    (create-buch-list)
    (print-obj rewr "rewr") 
    (when rewr 
        (write-buch-list-add))
    (unless rewr
        (write-buch-list-new))
    ;(read-buch-list)
    )

     
;;;;
(declaim (inline add-from-db))
(defun add-from-db ()
  "Добавляет новую базу данных книг"
  (print-obj " ---=== start add-from-db ===---")
  (read-buch-list)
  (create-new-db t))
;;;;
(defun find-from-db ( &key open1)
  "Поиск нужной книги и открытие последней в списке (open1) "
  (print-obj " ---=== start find-from-db ===---")
  (read-buch-list)
  (defvar *result* (list))
  (dolist (ba *bbk-arg*)
    (when ba
      (dolist (item *db*)
        (dolist (it (b-bbk item))
          ;(when (c:strstr it ba)

     
          (when (search ba it :test #'string-equal)
            (push item *result*))))))
  (dolist (ua *udk-arg*)
    (when ua
      (dolist (item *db*)
        (dolist (it (b-udk item))
          ;(when (c:strstr it ua)
          (when (search ua it :test #'string-equal)
            (push item *result*))))))
  (dolist (au *author-arg*)
    (when au
      (dolist (item *db*)
        (dolist (it (b-author item))
          ;(when (c:strstr it au)
          (when (search au it :test #'string-equal)
            (push item *result*))))))
  (dolist (an *annotation-arg*)
    (when an
      (print-obj an 'an)

     
      (dolist (item *db*)
        (setf it (b-annotation item))
        (print-obj it 'it-481)
        ;(when (c:strstr it an)
        (when (search an it :test #'string-equal)
          (print-obj it 'it-when)
          (push item *result*)
          (print-obj item 'item)
          (print-obj *result* '*result*)
          ;(stop)
          ))))
  (dolist (ta *title-arg*)
    (when ta
      (dolist (item *db*)
        (setf it (b-title item))
        ;(when (c:strstr it ta)
        (when (search ta it :test #'string-equal)
          (push item *result*)))))
  (dolist (ia *isbn-arg*)
    (when ia
      (dolist (item *db*)

     
        (setf it (b-isbn item))
        ;(when (c:strstr it ia)
        (when (search ia it :test #'string-equal)
          (push item *result*)))))
  (print-obj *result* 'resultat)
  ;(delete-duplicates *result*)
  (format t "~%~%~%Результаты поиска:~%")
  (dolist (v *result*)
    (viewb v t))
  (when open1
      (setf open2 (reverse *result*)) 
      (setf open3 (pop  open2))
      (setf type3 (pop (b-filetype open3)))
      (when (string-equal "txt" type3)
        (setf type3 (pop (b-filetype open3))))
      (print-obj type3 'type3)

     
      ;(setf open4 (format nil "~a/~a.~a" (b-filepath open3)
                                 ;(b-filename open3)
                                  ;type3))
      (setf open4 (make-pathname :directory (b-filepath open3)
                                 :name (b-filename open3)
                                 :type type3))
      (print-obj open4 'open4)
      (when (string-equal "pdf" type3)
        (setf open5 (format nil "~a "~a"" "evince" open4)))
      (when (string-equal "djvu" type3)
        (setf open5 (format nil "~a "~a"" "evince" open4)))
      (when (string-equal "fb2" type3)
        (setf open5 (format nil "~a "~a"" "ebook-viewer" open4)))
      (when (string-equal "htm" type3)
        (setf open5 (format nil "~a "~a"" "chromium" open4)))
      (when (string-equal "html" type3)
        (setf open5 (format nil "~a "~a"" "chromium" open4)))
      ;(when (string-equal "zip" type3)
        ;(setf open5 (format nil "~a "~a"" "ebook-viewer" open4)))
      (print-obj open5 'open5)

     
      (ext:shell open5)
      )
      
  )
;;;
(defun diff-fname ()
  "Поиск повторяющихся файлов"
  (print-obj " ---=== start diff-fname ===---")
  (read-buch-list)
  (setf *result* nil)
  ;(print-obj *db* '*db*)
  (dolist (item1 *db*)
     (setf ia (b-filename item1))
     ;(print-obj ia 'ia)
     (dolist (item2 *db*)
        (setf it (b-filename item2))
          (when (equal it ia)

     
            (unless (equal (b-filepath item1) (b-filepath item2))
              (push item1 *result*)))))
  (format t "~%~%~%Результаты поиска дублей:~%")
  (dolist (v *result*)
    (viewb v t)))
;;;;
;;;; end proc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; main
;;;;
(princ (compile 'read-buch-txt))

     
(princ (compile 'read-buch-fb2))
;;;; Обработка аргументов командной строки
(setf args ext:*args*)
(setf usage "Usage: ./mkart.lisp  -add-dir input-path-from-add-create[buch1/] -bbk bbk -udk udk -a author -t title -anons annotation -isbn isbn -o list-buch[inc/data.l] [-create|-add|-find|-open|-создать|-добавить|-найти|-открыть]] -df[diff-fname] (найти дубликат)")
(format t "~%~a~%~a~%" version usage)
(unless args (exit))
(print-obj args)
(setf comm :find)
(loop named argc
  for ar in args
  for argv = (length args) do

     
  (setf arg (pop args))
  (when (equal "-t" arg) (push (pop args) *title-arg*))
  (when (equal "-т" arg) (push (pop args) *title-arg*))
  (when (equal "-add-dir" arg) (setf *input-path* (pop args)))
  (when (equal "-o" arg) (setf *list-buch* (pop args)))
  (when (equal "-о" arg) (setf *list-buch* (pop args)))
  (when (equal "-bbk" arg) (push (pop args) *bbk-arg*))
  (when (equal "-ббк" arg) (push (pop args) *bbk-arg*))
  (when (equal "-udk" arg) (push (pop args) *udk-arg*))
  (when (equal "-удк" arg) (push (pop args) *udk-arg*))
  (when (equal "-a" arg) (push (pop args) *author-arg*))
  (when (equal "-а" arg) (push (pop args) *author-arg*))
  (when (equal "-anons" arg) (push (pop args) *annotation-arg*))
  (when (equal "-анонс" arg) (push (pop args) *annotation-arg*))
  (when (equal "-ann" arg) (push (pop args) *annotation-arg*))
  (when (equal "-анн" arg) (push (pop args) *annotation-arg*))
  (when (equal "-isbn" arg) (push (pop args) *isbn-arg*))
  (when (equal "-create" arg) (setf comm :create1))
  (when (equal "-add" arg) (setf comm :add1))
  (when (equal "-find" arg) (setf comm :find))

     
  (when (equal "-open" arg) (setf comm :open))
  (when (equal "-создать" arg) (setf comm :create1))
  (when (equal "-добавить" arg) (setf comm :add1))
  (when (equal "-найти" arg) (setf comm :find))
  (when (equal "-открыть" arg) (setf comm :open))
  (when (equal "-от" arg) (setf comm :open))
  (when (equal "-diff-fname" arg) (setf comm :diff-fname))
  (when (equal "-df" arg) (setf comm :diff-fname))
    ;(format t "~a: ~%" arg ))
  while args)
(case comm
  ( :create1  (create-new-db))
  ( :add1     (add-from-db))
  ( :diff-fname (diff-fname))
  ( :find     (find-from-db))

     
  ( :open     (find-from-db :open1 t)))
;;;;
;;;; end programm
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Эпилог

Функции программы документированы, переменные -- имеют доступные имена.

Но если появятся вопросы пишите.