;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2017 Danny Milosavljevic ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix 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. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu system uuid) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-modu
aboutsummaryrefslogtreecommitdiff
blob: 2b67ed1908cb46804c7c697ebe55f8c78bcb6380 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix 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.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages ocr)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages image))

(define-public ocrad
  (package
    (name "ocrad")
    (version "0.26")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/ocrad/ocrad-"
                                 version ".tar.lz"))
             (sha256
              (base32
               "0g4fq7maybdnd1471kd05a3f5sb7spa3d26k706rk85sd5wd70y3"))))
    (build-system gnu-build-system)
    (native-inputs `(("lzip" ,lzip)))
    (home-page "https://www.gnu.org/software/ocrad/")
    (synopsis "Optical character recognition based on feature extraction")
    (description
     "GNU Ocrad is an optical character recognition program based on a
feature extraction method.  It can read images in PBM, PGM or PPM formats and
it produces text in 8-bit or UTF-8 formats.")
    (license license:gpl3+)))

(define-public tesseract-ocr
  (package
    (name "tesseract-ocr")
    (version "3.04.01")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "https://github.com/tesseract-ocr/tesseract/archive/"
             version ".tar.gz"))
       (file-name (string-append name "-" version ".tar.gz"))
       (sha256
        (base32 "0snwd8as5i8vx7zkimpd2yg898jl96zf90r65a9w615f2hdkxxjp"))))
    (build-system gnu-build-system)
    (inputs
     `(("leptonica" ,leptonica)))
    (arguments
     '(#:configure-flags
       (let ((leptonica (assoc-ref %build-inputs "leptonica")))
         (list (string-append "LIBLEPT_HEADERSDIR=" leptonica "/include")))))
    (home-page "https://github.com/tesseract-ocr")
    (synopsis "Optical character recognition engine")
    (description
     "Tesseract is an optical character recognition (OCR) engine with very
high accuracy.  It supports many languages, output text formatting, hOCR
positional information and page layout analysis.  Several image formats are
supported through the Leptonica library.  It can also detect whether text is
monospaced or proportional.")
    (license license:asl2.0)))
string->ext2-uuid string->dce-uuid) (define string->ext3-uuid string->dce-uuid) (define string->ext4-uuid string->dce-uuid) (define string->bcachefs-uuid string->dce-uuid) (define string->btrfs-uuid string->dce-uuid) (define string->f2fs-uuid string->dce-uuid) (define string->jfs-uuid string->dce-uuid) (define string->xfs-uuid string->dce-uuid) (define-syntax vhashq (syntax-rules (=>) ((_) vlist-null) ((_ (key others ... => value) rest ...) (vhash-consq key value (vhashq (others ... => value) rest ...))) ((_ (=> value) rest ...) (vhashq rest ...)))) (define %uuid-parsers (vhashq ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks => string->dce-uuid) ('fat32 'fat16 'fat => string->fat-uuid) ('ntfs => string->ntfs-uuid) ('iso9660 => string->iso9660-uuid))) (define %uuid-printers (vhashq ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks => dce-uuid->string) ('iso9660 => iso9660-uuid->string) ('fat32 'fat16 'fat => fat-uuid->string) ('ntfs => ntfs-uuid->string))) (define* (string->uuid str #:optional (type 'dce)) "Parse STR as a UUID of the given TYPE. On success, return the corresponding bytevector; otherwise return #f." (match (vhash-assq type %uuid-parsers) (#f #f) ((_ . (? procedure? parse)) (parse str)))) ;; High-level UUID representation that carries its type with it. ;; ;; This is necessary to serialize bytevectors with the right printer in some ;; circumstances. For instance, GRUB "search --fs-uuid" command compares the ;; string representation of UUIDs, not the raw bytes; thus, when emitting a ;; GRUB 'search' command, we need to produce the right string representation ;; (see ). (define-record-type (make-uuid type bv) uuid? (type uuid-type) ;'dce | 'iso9660 | ... (bv uuid-bytevector)) (define* (bytevector->uuid bv #:optional (type 'dce)) "Return a UUID object make of BV and TYPE." (make-uuid type bv)) (define-syntax uuid (lambda (s) "Return the UUID object corresponding to the given UUID representation or #f if the string could not be parsed." (syntax-case s (quote) ((_ str (quote type)) (and (string? (syntax->datum #'str)) (identifier? #'type)) ;; A literal string: do the conversion at expansion time. (let ((bv (string->uuid (syntax->datum #'str) (syntax->datum #'type)))) (unless bv (syntax-violation 'uuid "invalid UUID" s)) #`(make-uuid 'type #,(datum->syntax s bv)))) ((_ str) (string? (syntax->datum #'str)) #'(uuid str 'dce)) ((_ str) #'(let ((bv (string->uuid str 'dce))) (and bv (make-uuid 'dce bv)))) ((_ str type) #'(let ((bv (string->uuid str type))) (and bv (make-uuid type bv))))))) (define uuid->string ;; Convert the given bytevector or UUID object, to the corresponding UUID ;; string representation. (match-lambda* (((? bytevector? bv)) (uuid->string bv 'dce)) (((? bytevector? bv) type) (match (vhash-assq type %uuid-printers) (#f #f) ((_ . (? procedure? unparse)) (unparse bv)))) (((? uuid? uuid)) (uuid->string (uuid-bytevector uuid) (uuid-type uuid))))) (define uuid=? ;; Return true if A is equal to B, comparing only the actual bits. (match-lambda* (((? bytevector? a) (? bytevector? b)) (bytevector=? a b)) (((? uuid? a) (? bytevector? b)) (bytevector=? (uuid-bytevector a) b)) (((? uuid? a) (? uuid? b)) (bytevector=? (uuid-bytevector a) (uuid-bytevector b))) (((or (? uuid? a) (? bytevector? a)) (or (? uuid? b) (? bytevector? b))) (uuid=? b a))))