#!/bin/sh
exec ${GUILE-guile} -e '(guile-baux uninstall-sofixed)' -s $0 "$@" # -*- scheme -*-
!#
;;; uninstall-sofixed --- manually do "libtool --mode=uninstall"

;; Copyright (C) 2007, 2020 Thien-Thi Nguyen
;;
;; This program 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, or
;; (at your option) any later version.
;;
;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Usage: uninstall-sofixed DIR FOO.la...
;;
;; NOTE: This program does, more or less, the equivalent of
;; "libtool --mode=uninstall FOO.la".  It is only necessary if
;; "libtool --mode=install" was followed by a call to "sofix".
;; This is because libtool (more precisely, GNU Libtool 1.5.26)
;; mines the filenames out of the installed .la file, which
;; sofix may or may not have deleted previously.
;;
;; This also deletes the installed .la file.
;;
;; Yes, this is ugly, but so is sofix.
;; Such a vicious circle.
;;
;; Do "sofix --help" for an explanation of DIR and FOO.la...,
;; which should be the same as for the sofix invocation.

;;; Code:

(define-module (guile-baux uninstall-sofixed)
  #:export (main)
  #:use-module ((guile-baux common) #:select (fs die check-hv qop<-args))
  #:use-module ((srfi srfi-13) #:select (string-tokenize))
  #:use-module ((srfi srfi-14) #:select (char-set:graphic
                                         char-set:ascii
                                         char-set-difference
                                         char-set-intersection
                                         string->char-set))
  #:use-module ((ice-9 popen) #:select (open-input-pipe
                                        close-pipe))
  #:use-module ((ice-9 rdelim) #:select (read-line)))

(define (strtok delims string)
  (string-tokenize
   string (char-set-difference
           ;; Clamp for performance.  However, DWR: likelihood
           ;; of non-ASCII library filenames low but non-zero.
           (char-set-intersection char-set:graphic char-set:ascii)
           (string->char-set delims))))

(define (DIE s . args)
  (die #f (apply fs (string-append (basename (car (command-line)))
                                   ": " s
                                   " (try --help)~%")
                 args)))

(define (get-dir qop)                   ; => directory (string)
  (let* ((all (qop '()))
         (dir (false-if-exception (car (qop '())))))
    (cond ((not dir)
           (DIE "Missing DIR"))
          ((or (not (file-exists? dir))
               (not (file-is-directory? dir)))
           (DIE "Invalid DIR: ~S" dir)))
    ;; rv
    dir))

(define (main/qop qop)
  (let ((inst (get-dir qop)))

    (define (rm-f relname)
      (let ((filename (in-vicinity inst relname)))
        (and (file-exists? filename)
             (delete-file filename))))

    (define (one la)

      (define (sed var)
        (let* ((p (open-input-pipe (fs "sed '/^~A=/!d' ~A" var la)))
               (line (substring (read-line p) (1+ (string-length var)))))
          (close-pipe p)
          ;; rv
          (strtok "'" line)))

      (or (file-exists? la)
          (DIE "No such file: ~A" la))
      (for-each rm-f (sed "library_names"))
      (rm-f (basename la)))

    (for-each one (or (false-if-exception (cdr (qop '())))
                      '())))
  #t)

(define (main args)
  (check-hv args '((package . "Guile-BAUX")
                   (version . "2.0")
                   ;; 2.0 -- reimpl in Scheme; add to Guile-BAUX
                   ;; 1.1 -- impl in sh; independent
                   (help . commentary)))
  (exit (main/qop (qop<-args args '()))))

;;; uninstall-sofixed ends here
