gnu: All snippets report errors using exceptions, else return #t.
[jackhill/guix/guix.git] / gnu / packages / netpbm.scm
1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
3 ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
4 ;;;
5 ;;; This file is part of GNU Guix.
6 ;;;
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
11 ;;;
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
16 ;;;
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20 (define-module (gnu packages netpbm)
21 #:use-module (gnu packages)
22 #:use-module (gnu packages compression)
23 #:use-module (gnu packages flex)
24 #:use-module (gnu packages ghostscript)
25 #:use-module (gnu packages image)
26 #:use-module (gnu packages perl)
27 #:use-module (gnu packages pkg-config)
28 #:use-module (gnu packages python)
29 #:use-module (gnu packages xml)
30 #:use-module (gnu packages xorg)
31 #:use-module (guix build-system gnu)
32 #:use-module ((guix licenses) #:select (gpl2))
33 #:use-module (guix packages)
34 #:use-module (guix svn-download))
35
36 (define-public netpbm
37 (package
38 (name "netpbm")
39 (version "10.78.3")
40 (source (origin
41 (method svn-fetch)
42 ;; At the time of first packaging, the "super-stable" and
43 ;; "stable" versions did not compile with newer libpng;
44 ;; we needed the "advanced" version.
45 ;; The currently highest stable version is 10.47.53,
46 ;; the currently highest advanced version is 10.69.4,
47 ;; svn release 2397.
48 ;; To determine the correct release: "svn log version.mk".
49 (uri (svn-reference
50 (url "http://svn.code.sf.net/p/netpbm/code/advanced")
51 (revision 2965)))
52 (sha256
53 (base32
54 "1k7as9qi1942wyjxpvbf02wg0h4braw44m3m3vvi8sm9y5z1m967"))
55 (file-name (string-append name "-" version "-checkout"))
56 (modules '((guix build utils)))
57 (snippet
58 '(begin
59 ;; Remove non-FSDG-compliant code.
60
61 (define-syntax drop
62 (syntax-rules (in)
63 ;; Remove PROGRAM from DIRECTORY/Makefile, and remove
64 ;; DIRECTORY/PROGRAM and DIRECTORY/PROGRAM.c.
65 ((_ program ... in directory)
66 (begin
67 (substitute* (string-append directory "/Makefile")
68 ((program) "") ...)
69
70 (let* ((subdir (string-append directory "/" program))
71 (dot-c (string-append subdir ".c")))
72 (when (file-exists? subdir)
73 (delete-file-recursively subdir))
74 (when (file-exists? dot-c)
75 (delete-file dot-c)))
76
77 ...))))
78
79 ;; Drop advertisement for non-free program.
80 (drop "hpcdtoppm" in "converter/ppm")
81
82 ;; Drop programs without a license, see
83 ;; <http://packages.debian.org/changelogs/pool/main/n/netpbm-free/netpbm-free_10.0-12.2/libnetpbm10.copyright>.
84 (drop "pbmto4425" "pbmtoln03" "pbmtolps" "pbmtopk" "pktopbm"
85 in "converter/pbm")
86 (drop "spottopgm" in "converter/pgm")
87 (drop "ppmtopjxl" in "converter/ppm")
88
89 ;; Remove timestamps from the generated code.
90 (substitute* "buildtools/makepointerman"
91 (("gmctime[(][)]")
92 "\"Thu Jan 1 00:00:00 1970\""))
93 (substitute* "buildtools/stamp-date"
94 (("^DATE=.*")
95 "DATE=\"Thu Jan 01 00:00:00+0000 1970\"\n")
96 (("^USER=.*")
97 "USER=Guix\n"))
98 #t))))
99
100 (build-system gnu-build-system)
101 (inputs `(("ghostscript" ,ghostscript)
102 ("libjpeg" ,libjpeg)
103 ("libpng" ,libpng)
104 ("libtiff" ,libtiff)
105 ("libxml2" ,libxml2)
106 ("xorg-rgb" ,xorg-rgb)
107 ("zlib" ,zlib)))
108 (native-inputs
109 `(("flex" ,flex)
110 ("perl" ,perl)
111 ("pkg-config" ,pkg-config)
112 ("python" ,python-wrapper)))
113 (arguments
114 `(#:phases
115 (modify-phases %standard-phases
116 (replace 'configure
117 (lambda* (#:key inputs outputs #:allow-other-keys)
118 (copy-file "config.mk.in" "config.mk")
119 (chmod "config.mk" #o664)
120 (let ((f (open-file "config.mk" "a")))
121 (display "CC=gcc\n" f)
122 (display "CFLAGS_SHLIB += -fPIC\n" f)
123 (display "TIFFLIB = libtiff.so\n" f)
124 (display "JPEGLIB = libjpeg.so\n" f)
125 (display "ZLIB = libz.so\n" f)
126 (display (string-append "LDFLAGS += -Wl,-rpath=" %output "/lib") f)
127 (close-port f))
128
129 (let ((rgb (string-append (assoc-ref inputs "xorg-rgb")
130 "/share/X11/rgb.txt")))
131 (substitute* "config.mk"
132 (("/usr/share/netpbm/rgb.txt") rgb))
133
134 ;; Our Ghostscript no longer provides the 'gs' command, only
135 ;; 'gsc', so look for that instead.
136 (substitute* "converter/other/pstopnm.c"
137 (("\"%s/gs\"")
138 "\"%s/gsc\"")))
139 #t))
140 (add-before 'check 'setup-check
141 (lambda _
142 ;; install temporarily into /tmp/netpbm
143 (system* "make" "package")
144 ;; remove test requiring X
145 (substitute* "test/all-in-place.test" (("pamx") ""))
146 ;; do not worry about non-existing file
147 (substitute* "test/all-in-place.test" (("^rm ") "rm -f "))
148 ;; remove four tests that fail for unknown reasons
149 (substitute* "test/Test-Order"
150 (("all-in-place.test") "")
151 (("pnmpsnr.test") "")
152 (("pnmremap1.test") "")
153 (("gif-roundtrip.test") "")
154
155 ;; These two tests started failing in netpbm-10.78.3.
156 (("jpeg-roundtrip.test") "")
157 (("pbmtext.test") "")
158
159 ;; Skip tests that use nonfree programs that we don't build.
160 (("ps-alt-roundtrip.test") "" )
161 (("pbm-misc-converters.test") ""))
162 #t))
163 (replace 'install
164 (lambda* (#:key outputs make-flags #:allow-other-keys)
165 (let ((out (assoc-ref outputs "out")))
166 (apply system* "make" "package"
167 (string-append "pkgdir=" out) make-flags)
168 ;; copy static library
169 (copy-file (string-append out "/link/libnetpbm.a")
170 (string-append out "/lib/libnetpbm.a"))
171 ;; remove superfluous folders and files
172 (system* "rm" "-r" (string-append out "/link"))
173 (system* "rm" "-r" (string-append out "/misc"))
174 (with-directory-excursion out
175 (for-each delete-file
176 '("config_template" "pkginfo" "README"
177 "VERSION")))
178 #t))))))
179 (synopsis "Toolkit for manipulation of images")
180 (description
181 "Netpbm is a toolkit for the manipulation of graphic images, including
182 the conversion of images between a variety of different formats.
183 There are over 300 separate tools in the package including converters for
184 about 100 graphics formats.")
185 (license gpl2)
186 (home-page "http://netpbm.sourceforge.net/")))