#!/usr/bin/env -S guile -e start -s
!#
;;; coding: utf-8
;;; $Id: debian-copyrighter.scm,v 1.40 2022/12/16 17:46:04 fpp Exp fpp $
;;; Copyright © 2022 Frank Pursel <frank.pursel@gmail.com>

 ;; The debian-copyrighter 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.
 ;; .
 ;; The debian-copyrighter 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 The debian-copyrighter.  If not, see <http://www.gnu.org/licenses/>.
 ;; .
 ;; On Debian systems, the complete text of the GNU General Public License
 ;; Version 3 can be found in `/usr/share/common-licenses/GPL-3'.


;; Guile tools to assist in automating the creation of debian copyright files as
;; at https://www.debian.org/doc/packaging-manuals/copyright-format/1.0
(use-modules
 (ice-9 getopt-long)
 (ice-9 format)
 (ice-9 ftw)
 (srfi srfi-1)
 (srfi srfi-9)
 (srfi srfi-9 gnu)
 (srfi srfi-11)
 (ice-9 regex)
 (ice-9 rdelim)
 (srfi srfi-64))

;; Default project data.
(define project-name "guix")
(define project-license 'GPL-3.0+)
(define project-source "https://ftp.gnu.org/gnu/guix")

(define-record-type <licensed-file>
  (make-licensed-file full-name dir license copyright-list)
  licensed-file?
  (full-name licensed-file-name set-licensed-file-name!)
  (dir licensed-file-dir set-licensed-file-dir!)
  (license licensed-file-license set-licensed-file-license!)
  (copyright-list licensed-file-copyright-list set-licensed-file-copyright-list!))
(define-record-type <copyright>
  (make-copyright tag year-list)
  copyright?
  (tag copyright-tag set-copyright-tag!)
  (year-list copyright-year-list set-copyright-year-list!))

;;; Tools to compress a list of numeric years.
(define (group-adj-aux sorted-l res)
  (if (null? sorted-l)
      (reverse res)
      (group-adj-aux (cdr sorted-l) (if (memv (+ 1 (car (car res))) sorted-l)
					(cons (cons (car sorted-l) (car res)) (cdr res))
					(cons (list (car sorted-l)) res)))))

(define (group-adj num-lst)
  (let ((sl (sort num-lst <=)))
    (group-adj-aux (cdr sl) (list (list (car sl))))))

(define (stringify-group lst)
  (if (< (length lst) 2)
      (number->string (car lst))
      (let ((sl (sort lst <=)))
	(string-concatenate (list
			     (number->string (car sl))
			     "-"
			     (number->string (last sl)))))))


(define (compr-yr-lst-aux groups res)
  (if (null? groups)
      res
      (compr-yr-lst-aux (cdr groups) (string-concatenate
				      (list res "," (stringify-group (car groups)))))))

(define (compr-yr-lst yr-lst)
  "Return a string describing both consecutive and non-consecutive ranges of years."
  (if (null? yr-lst)
      ""
      (let* ((groups (group-adj yr-lst)))
	(string-drop (compr-yr-lst-aux groups "") 1)
	)))

(define (min-max-yr-lst yr-lst)
  "Return the span of all copyr years, eg (min-max-yr-lst (list 1995 1996 2005))
returns \"1995,2005\".  Or the empty string for no copyrights."
  (let ((len-yr-lst (if (null? yr-lst) 0 (length yr-lst))))
    (cond
	  ((zero? len-yr-lst) "")
	  ((= 1 len-yr-lst) (format #f "~a" (car yr-lst)))
	  (#t  (let* ((sorted-num-list (sort yr-lst <=))
		      (min-yr (car sorted-num-list))
		      (max-yr (car (reverse sorted-num-list))))
		 (format #f "~a,~a" min-yr max-yr)))
	  )
    )
  )

;; Defining default copyright years display format func
(define display-cprt-yrs compr-yr-lst)

					;(test-begin "Compression of year lists to string")
					;(test-assert (string=? "1990,1999-2000,2020-2022" (compr-yr-lst test-yr-list)))
					;(test-end)

;;; Tools to convert year strings to number-year lists.
(define (years-fm-lst lst res)
  (let ((regex (make-regexp "(20|19)[8,9,0,1,2][0-9]" )))
    (let nxt-yr ((l lst) (result '()))
      (if (null? l)
	  result
	  (nxt-yr (cdr l) (let ((rr (regexp-exec regex (car l))))
			    (if rr
				(cons (string->number (match:substring rr)) result)
				result)))
	  ))))

(define (expand-hyphen-yrs h-yr-str)
  (let* ((str-l (string-split h-yr-str (string-ref h-yr-str 4)))
	 (n-lst (sort (map string->number str-l) <=))
	 (low (car n-lst))
	 (high (cadr n-lst)))
    (string-join (map number->string (iota (- high low -1) low)) ",")
    )
  )


(define hy-yrs-cre (make-regexp "(19|20)[8,9,0,1,2][0-9][-–](19|20)[8,9,0,1,2][0-9]"))

(define (dehyphenate-line str)
  (let ((match? (regexp-exec hy-yrs-cre str)))
    (if match?
	(dehyphenate-line
	 (regexp-substitute #f match?
			    'pre (expand-hyphen-yrs (match:substring match?)) 'post))
	str))
  )

;(test-begin "Line dehyphenation")
;(test-assert (string=? "1999,2000,2001" (dehyphenate-line "1999-2001")))
;(test-assert (string=? "1999,2000,2001,2005" (dehyphenate-line "1999-2001,2005")))
;; (test-assert (string=? (dehyphenate-line "1999-2001,2009,2020-2022")
;; 		       "1999,2000,2001,2009,2020,2021,2022"))
;(test-end "Line dehyphenation")


(define (years-str->nlst str)
  (let ((dehyphenated (dehyphenate-line str)))
    (filter number? (map string->number (map string-trim-both (string-split dehyphenated #\,)))))
  )

;; (test-begin "strings-to-lists-of-numbers")
;; (test-assert (equal? (list 1999 2000 2001) (years-str->nlst "1999-2001")))
;; (test-assert (equal? (list 1999 2000 2001 2005 2006 2007)
;; 		     (years-str->nlst "1999-2001,2005-2007")))
;; (test-assert (equal? (list 2000 2001 2002 2010)
;; 		     (years-str->nlst (compr-yr-lst (list 2000 2001 2002 2010)))))
;; (test-end "strings-to-lists-of-numbers")

(define licenses
  (list
   '(GPL-3.0+ "Id: debian-copyrighter.scm")
   '(Expat-and-GPL-3.0+ "GNU General Public License" "Version 3" "any later"
			"Permission is hereby granted, free of charge, to any person obtaining")
   '(GPL-3.0+ "GNU General Public License" "Version 3" "any later")
   '(GPL-3.0+ "same license as the( GNU)* guix package")
   '(GPL-2.0+ "GNU General Public License" "version 2" "any later")
   '(GPL-2or3 "GNU General Public License" "version 2" "version 3")
   '(LGPL-2.1+ "GNU Lesser General Public"
	       "version 2.1" "any later")
   '(LGPL-3.0+ "GNU Lesser General Public"
	       "This library is free software"
	       "version 3")
   '(GFDL-1.3+ "GNU Free Documentation" "Version 1.3" "any later")
   '(GFDL "GNU Free Documentation License")
   '(GLGPL "GNU Library General Public License")
   '(BSD-2-Clause "Redistribution" "provided that the following conditions are met:"
		  "1" "2" "AS IS")
   '(BSD-3-Clause "Redistribution" "provided that the following conditions are met:"
		  "Neither the name of the author nor the names of contributors")
   '(Expat "Permission is hereby granted, free of charge, to any person obtaining")
   '(MIT "MIT License")
   '(PERMISSIVE "This file can be copied and used freely without restrictions."
		"It can be used in projects which are not available")
   '(PERMISSIVE-VARIANT1 "Copying and distribution of this file, with or without modification" "are permitted in any medium without royalty")
   '(PERMISSIVE-VARIANT2 "Permission to copy, use, modify, sell and distribute")
   '(UNKNOWN "(source|permission|distribut|modify)") ;; Incomplete results must be at end.
		    ))

(define (lines-of-file fn)
  (let ((iport (open-file fn "r" )))
    (do ((line (read-line iport) (read-line iport))
	 (result '() (cons line result)))
	((eof-object? line) (begin (close-port iport) (reverse result))))))

(define (file-contains-icase? re)
  (let ((compiled-re (make-regexp re regexp/icase)))
    (lambda (lof)
      (any (lambda (l-of-f) (regexp-exec compiled-re l-of-f)) lof)))
  )

(define lof-contains-license? (file-contains-icase? " license "))

(define (dir-from-full-file-name ffn)
  (string-join (reverse (cdr (reverse (string-split ffn #\/)))) "/"))

(define (test-lic? lic-clause)
  "When applied to a file-string we return either #f or the symbol of the successfully tested license clause.  One of licenses, above."
  (lambda (file-str)
    (let* ((lic-symb (car lic-clause))
	   (lic-tests (cdr lic-clause))
	   (compiled-lic-tests (map (lambda (re) (make-regexp re regexp/icase)) lic-tests)))
      (and (every (lambda (c-re) (regexp-exec c-re file-str)) compiled-lic-tests) lic-symb)))
  )

(define license-tests (map test-lic? licenses))

(define (license-of lof tests)
  "When applied to a list of the lines in a file this returns the symbol of a matching license or 'any, which indicates no license was identified."
  (let ((file-str (string-join lof " ")))
    (any (lambda (lic-test) (lic-test file-str) ) tests)))

;; (test-group "license-of"
;;   (test-assert (not ((test-lic? (list 'x-sym "A" "tree")) "A buffalo")))
;;   (test-assert (eq? 'xsym ((test-lic? (list 'xsym "A" "tree")) "A tree and more"))))

(define years-re (make-regexp "((20|19)[8,9,0,1,2][0-9][-–,]? ?)+"))


(define (make-copyright-from match)
  (let* ((years-mat (regexp-exec years-re (match:suffix match)))
	 (years-str (if years-mat (match:substring years-mat) (match:substring match)))
	 (tag-str (if years-mat
		      (string-drop (match:suffix match) (string-length years-str))
		      (match:substring match))))
    (make-copyright tag-str (years-str->nlst years-str))))
  

(define copyr-re (make-regexp
		  (string-concatenate
		   (list "copyright (\\([Cc]\\)|"
			 (list->string (list #\x00A9))
			 ") "))
		  regexp/icase))

(define (copyrights-of-aux lof)
  (if (null? lof)
      '()
      (let ((match? (regexp-exec copyr-re (car lof))))
	(if match?
	    (cons
	     (make-copyright-from match?)
	     (copyrights-of-aux (cdr lof)))
	    (copyrights-of-aux (cdr lof))))))

(define copyright-po-cre (make-regexp "([-–,] ?(20|19)[8,9,1,2][0-9])+\\.?[[:blank:]]*$"))

(define (make-copyright-from-po match)
  (let* ((tag-str (string-drop (match:prefix match) 2))
	 (dirty-years-str (match:substring match))
	 (years-str-minus-dot (if (string-match "\\." dirty-years-str)
				  (regexp-substitute #f
						     (string-match "\\." dirty-years-str)
						     'pre "" 'post)
				  dirty-years-str))
	 (years-str (regexp-substitute #f (string-match "^, " years-str-minus-dot) 'post)))
    (make-copyright tag-str (years-str->nlst years-str))
    ))

(define (copyrights-of-po-aux lof)
  (if (null? lof)
      '()
      (let ((match? (regexp-exec copyright-po-cre (car lof))))
	(if match?
	    (cons
	     (make-copyright-from-po match?)
	     (copyrights-of-po-aux (cdr lof)))
	    (copyrights-of-po-aux (cdr lof)))))
  )

(define (copyrights-of lof bname)
  (if (string-match ".*\\.po$" bname)
      (append (copyrights-of-aux lof) (copyrights-of-po-aux lof))
      (copyrights-of-aux lof)))

(define (enter? name stat results)
  (not (string-match "\\.git" name)))

(define (leaf name stat result)
  (let ((res result))
    (if #t   ;; (string-match ".*\\.(scm|po)$" name)
	(let ((lof (lines-of-file name))
	      )
	  (if (lof-contains-license? lof)
	      (hash-set! res name (make-licensed-file
				   name
				   (dir-from-full-file-name name)
				   (license-of lof license-tests)
				   (copyrights-of lof (basename name))))
	      )
	  ))
    res
    )
  )

(define (filter-empty-copyrights copyr-list)
  (let* ((copyr-re (make-regexp "copyright" regexp/icase))
	 (empty-copyr?
	  (lambda (copyr)
	    (not (regexp-exec copyr-re (copyright-tag copyr)))))
	 )
    (filter empty-copyr? copyr-list))
  )

(define (base-cut-leaf base-dir exclusion-func)
  (let ((trim-base (lambda (name)
		     (let ((lbd (string-length base-dir)))
		       ;; (if (char=? #\/ (last (string->list base-dir)))
		       ;; 	   (substring name (1+ lbd))
		       ;; 	   (substring name lbd)
		       ;; 	   )
		       (substring name (1+ lbd))
		       ))))
    (lambda (name stat result)
      (let ((res result))
	(if (exclusion-func name stat result) ;;#t or (string-match ".*\\.(scm|po)$" name)
	    (let ((lof (lines-of-file name))
		  )
	      (if (lof-contains-license? lof)
		  (hash-set! res name (make-licensed-file
				       (trim-base name)
				       (dir-from-full-file-name name)
				       (license-of lof license-tests)
				       (filter-empty-copyrights
					(copyrights-of lof (basename name)))))
		  )
	      ))
	res
	))))

(define (up name stat results) results)
(define (down name stat results) results)
(define (skip name stat results) results)
(define (err name stat errno results) results)

(define (hash-for-dir-tree dir)
  "Main entry point to scan a directory tree and return a hash of all files with license and copyright analyses."
  (let ((leaf (base-cut-leaf dir (const #t))))
    (file-system-fold enter? (base-cut-leaf dir (const #t)) down up skip err
		      (make-hash-table 1200)
		      dir)))

(define (enter-w-exclusions? excl-list)
  "Provided a set of regular-expressions return an enter? function. Delimited defined by excl-delim-char"
  (if (null? excl-list)
      (lambda (name stat results) #t)
      (let* ((l-regex excl-list)
	     (l-reg-compiled (map (lambda (reg) (make-regexp reg)) l-regex))
	     (check-name?
	      (lambda (fname)
		(any (lambda (cregexp) (regexp-exec cregexp fname)) l-reg-compiled))))
	(lambda (name stat results)
	  (not (check-name? name))))))

(define (hash-for-dir-tree-w-exclusions dir regexp-list)
  (let ((leaf (base-cut-leaf dir (enter-w-exclusions? regexp-list)))
	(enter? (enter-w-exclusions? regexp-list)))
    (file-system-fold enter? leaf down up skip err
		      (make-hash-table 1200)
		      dir)))

(define (problems-to-investigate dir)
  (let ((loc-hash (hash-for-dir-tree dir)))
    (list (cons 'no-copyright-files
		(hash-fold (lambda (k v p)
			     (if (= 0 (length (licensed-file-copyright-list v)))
				 (cons k p)
				 p))
			   '()
			   loc-hash))
	  (cons 'no-license-files
		(hash-fold (lambda (k v p)
			     (if (eq? 'any (licensed-file-license v))
				 (cons k p)
				 p))
			   '()
			   loc-hash))
	  (cons 'data-hash loc-hash))))

(define (freq-aux lst res)
  (if (null? lst)
      res
      (let-values (((car-part cdr-part)
		    (partition
		     (lambda (e) (eq? e (car lst)))
		     lst)))
	(freq-aux cdr-part (alist-cons (car lst) (length car-part) res)))))

(define (freq lst)
  "Return an alist uniq elements from lst with count of each."
  (freq-aux lst '()))

(define (license-freq dir hash)
  (freq (hash-fold (lambda (k v p) (if (string=? dir (licensed-file-dir v)) (cons (licensed-file-license v) p) p)) '() hash))
  )

(define (dirs-in-tree base-dir)
  (let ((entry? (lambda (name stat result ) (not (string-match "\\.git" name))))
	(leaf (lambda  (name stat result) result))
	(skip (lambda  (name stat result) result))
	(up (lambda  (name stat result) (cons name result)))
	(down (lambda  (name stat result) result))
	(err (lambda  (name stat errno result) result))
	)
    (file-system-fold entry? leaf down up skip err '() base-dir)))

(define (single-licensed-dir? dir hash)
  (let ((lic-lst (license-freq dir hash)))
    (if (= 1 (length lic-lst))
	(car (car lic-lst))
	#f)))

(define (licenses-found hash)
  "Given a dir-tree hash return a list of license symbols returned."
  (hash-fold (lambda (k v p) (lset-adjoin eq? p (licensed-file-license v)) )
	     '()
	     hash))

(define (license-counts hash lic-list)
  "Given the hash and list of licenses return a sorted alist of
(license . count) elements"
  (sort (map (lambda (lic)
	       (cons lic (hash-count
			  (lambda (k v) (eq? lic (licensed-file-license v)))
			  hash)))
	     lic-list)
	(lambda (x y) (>= (cdr x) (cdr y))))
  )

(define (join-copyright-lists res new-crl)
  (if (null? new-crl)
      res
      (join-copyright-lists 
       (let ((match? (assoc (caar new-crl) res)))
	 (if match?
	     (let* ((tag (car match?))
		    (res-copyright (cdr match?))
		    (res-yr-lst (copyright-year-list res-copyright))
		    (new-crl-yr-lst (copyright-year-list (cdar new-crl)))
		    (joint-year-list (lset-union eqv? res-yr-lst new-crl-yr-lst))
		    (updated-copyr (make-copyright tag joint-year-list)))
	       (assoc-set! res tag updated-copyr))
	     (acons (caar new-crl) (cdar new-crl) res)))
       (cdr new-crl))))

(define (consolidate-copyright-lists-aux copyr-list res)
  (if (null? copyr-list)
      res
      (consolidate-copyright-lists-aux
       (cdr copyr-list)
       (join-copyright-lists res (car copyr-list)))))

(define (consolidate-copyright-lists copyr-lst)
  (consolidate-copyright-lists-aux
   (cdr copyr-lst)
   (car copyr-lst)
   ))

(define (expanded-copyr-list copyr-list)
  (map (lambda (copyr) (cons (copyright-tag copyr) copyr)) copyr-list))

(define (licensed-files/license hash lic)
  (let ((alist-of-lic (hash-fold (lambda (k v p) (if (eq? lic (licensed-file-license v)) (acons (licensed-file-name v) v p) p)) '() hash)))
    (make-licensed-file
     (apply list (map car alist-of-lic))
     #f
     lic
     (consolidate-copyright-lists
      (map
       (compose expanded-copyr-list licensed-file-copyright-list cdr)
       alist-of-lic))
     )
    ))


(define (hash-head n hash)
  "Returns a list of licensed-file records n elems long."
  (hash-fold (lambda (k v p) (if (< (length p) n) (cons v p) p)) '() hash))

(define (gather-copyrights k licensed-file-rec copyr-alist)
  (let* ((copyright-list (licensed-file-copyright-list licensed-file-rec)))
    (let proc-copyr ((copyr-l copyright-list) (alist copyr-alist))
      (if (null? copyr-l)
	  alist
	  (proc-copyr (cdr copyr-l)
		      (let* ((next-copyright (car copyr-l))
			     ;(yr-str (car next-c))
			     (yr-list (copyright-year-list next-copyright))
			     (tag-str (copyright-tag next-copyright))
			     (existing-cr? (assoc tag-str alist)))
			(if existing-cr?
			    (let* ((all-yr-lst (lset-union eqv? yr-list (copyright-year-list (cdr existing-cr?)))))
			      (assoc-set! alist tag-str (make-copyright tag-str all-yr-lst)))
			    (acons tag-str next-copyright alist)
			    )
			)))
      )))

;;; Getting all copyrights into alist for 
(define (all-copyrights hash)
  "Return alist keyed on copyright holder strings holding list of copyright years."
  (hash-fold gather-copyrights '() hash))

(define (fmt-copyright copyr-fm-alist)
  (string-concatenate (list (display-cprt-yrs (cdr copyr-fm-alist)) " " (car copyr-fm-alist) "\n")))


;;; Partitioning copyrights for a particular set of file directories

;; First need to convert licensed-file hash to an alist so we can partition all files.
(define (licensed-files-to-alist hash)
  (hash-fold (lambda (k v p) (cons v p) ) '() hash))

;; report out a globbed dir and return the other partition

;;; Partition files by license starting with the largest
;;; the largest partition will be attributed to *
;;; Subsequent licenses will list the licensed filenames.

(define sort-copyrights-by-tag-then-first-4
  (lambda (copyr-lst)
    (sort copyr-lst
	  (lambda (x y)
	    (let* ((x-yl (copyright-year-list (cdr x)))
		   (y-yl (copyright-year-list (cdr y)))
		   (x-f-y (if (null? x-yl)
			      '()
			      (car (sort x-yl <=))))
		   (y-f-y (if (null? y-yl)
			      '()
			      (car (sort y-yl <=))))
		   )
	      (if (and (number? x-f-y) (number? y-f-y) (= x-f-y y-f-y))
		  (string<=? (copyright-tag (cdr x)) (copyright-tag (cdr y)))
		  (and (number? x-f-y) (number? y-f-y) (<= x-f-y y-f-y))
		  ))))
    ))

;;; Record printing tools 
(set-record-type-printer!
 <copyright>
 (lambda (rec port)
   (format port " ~a ~a~%"
	   (display-cprt-yrs (copyright-year-list rec))
	   (copyright-tag rec))))
(set-record-type-printer!
 <licensed-file>
 (lambda (rec port)
   (let ((name (licensed-file-name rec)))
     (if (not (list? name))
	 (format port
		 "File: ~a~%Copyright:\n~a~%License: ~a~%"
		 name
		 (string-join
		  (map (lambda (copyr-rec) (string-concatenate
					    (list
					     " "
					     (display-cprt-yrs
					      (copyright-year-list copyr-rec))
					     " "
					     (copyright-tag copyr-rec))))
		       (licensed-file-copyright-list rec))
		  "\n")
		 (licensed-file-license rec))
	 (format port
		 "Copyright:\n~a~%License: ~a~%"
		 (let ((copr-l (sort-copyrights-by-tag-then-first-4 (licensed-file-copyright-list rec))))
		   (if (null? copr-l)
		       ""
		       (string-join
			(map (lambda (ae)
			       (let ((copyr (cdr ae)))
				 (string-concatenate
				  (list
				   " "
				   (display-cprt-yrs (copyright-year-list copyr))
				   " "
				   (copyright-tag copyr)))))
			     copr-l)
			"\n")))
		 (licensed-file-license rec))
	 ))))

(define (all-output dir-tree exclusion-list)
  (let* ((d-hash (hash-for-dir-tree-w-exclusions dir-tree exclusion-list))
	 (alist (hash-fold (lambda (k v p) (acons k v p)) '() d-hash))
	 (sorted-al (sort alist (lambda (x y) (string<=? (car x) (car y))))))
    (for-each
     (lambda (file-rec)
       (display (cdr file-rec))
       (newline))
     sorted-al)
    ))

(define (default-output dir-tree exclusion-list)
  (let* ((d-hash (hash-for-dir-tree-w-exclusions dir-tree exclusion-list))
	 (license-freqs (license-counts d-hash (licenses-found d-hash)))
	 (dominant-lic (caar license-freqs))
	 (rem-licenses (map car (cdr license-freqs)))
	 )
    (format #t "Files: *~%~a~%"
	    (licensed-files/license d-hash dominant-lic))
    (for-each
     (lambda (lic)
       (let ((licensed-file-rec (licensed-files/license d-hash lic)))
	 (format #t "Files:\n ~a~%"
		 (string-join
		   (licensed-file-name licensed-file-rec) "\n "))
	 (display licensed-file-rec)
	 (newline)))
     rem-licenses)
    ))

(define (margs opt-name parsed-opts default-regexp)
  (let* ((pairs (filter (lambda (cell) (pair? cell)) parsed-opts))
	 (matched-pairs (filter (lambda (cell) (eq? (car cell) opt-name)) pairs))
	 )
    (if (> (length matched-pairs) 0)
	(map cdr matched-pairs)
	default-regexp)))


(define (start args)
  (let* ((option-spec '((dir (single-char #\d) (value #t))
			(exclusions (single-char #\x) (value #t))
			(list-files (single-char #\L) (value #f))
			(short-years (single-char #\s) (value #f))
			(all (single-char #\A) (value #f))
			(help (single-char #\h) (value #f))))
	 (options (getopt-long args option-spec))
	 (dir-provided (option-ref options 'dir #f))
	 (ex-list (margs 'exclusions options '()))
	 (list-files (option-ref options 'list-files #f))
	 (shorten-years (option-ref options 'short-years #f))
	 (all (option-ref options 'all #f))
	 (help-wanted (option-ref options 'help #f))
	 )
    (if help-wanted
	(display "
debian-copyrighter [options]
  -h,  --help  Display this help
  -d,  --dir   (required) Provide directory path for scanning
  -s,  --short-years  display copyright years in shortest form
  -x,  --exclusions Possibly multiple regular-expressions for
               dirs and/or files to be excluded from analysis
  -A,  --all   Lists license, copyright holders for all files (long)

Scans the provided dir for files containing license
information and outputs collective summary of copyright holder
information found.

If -x is provided with a regular expression directories or filenames
matching any of these patterns will be excluded from processing.  By
default this list is empty.  Multiple -x options can be added to the
command line.

If -A is selected each file is listed individually.  Suited for
filtering, troubleshooting or exploration.
"))
    (if shorten-years (set! display-cprt-yrs min-max-yr-lst))
    (if dir-provided
	(cond
	 (all (all-output dir-provided ex-list))
	 (list-files #t)
	 (#t (begin
	       (display (string-concatenate (list "Scanning: " dir-provided "\n")))
	       (default-output dir-provided ex-list))))
	(display "Must provide the directory to read using the -d option. Or get --help.\n")
	)
    )
  )
