glenn
/
stash
mirror of https://codeberg.org/glenneth/stash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

push code base

This commit is contained in:
GLENN THOMPSON 2024-09-08 12:35:24 +03:00
parent 8b1e51ea5e
commit fd6d395bf8
2 changed files with 171 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
LICENSE Normal file
View File

@ -0,0 +1,21 @@
MIT License
Copyright (c) 2024 Glenn Thompson
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

150
guile-stash.scm Normal file
View File

@ -0,0 +1,150 @@
;;; guile-stash.scm --- A Guile script for creating and managing symlinks with conflict resolution
;;;
;;; Author: Glenn Thompson <glenn@kirstol.org>
;;; Version: 1.1
;;; Created: 2024-12-03
;;; Compatibility: Guile 3.0.9
;;; Keywords: symlink, file management, conflict resolution
;;;
;;; Commentary:
;;;
;;; Guile-Stash is a command-line utility written in Guile Scheme designed to facilitate the creation of symbolic links (symlinks)
;;; for files and directories. It allows users to specify a source file or directory and a target directory where the symlink(s)
;;; should be created. The utility handles potential conflicts with existing files or directories at the target location,
;;; offering users the choice to overwrite or skip the creation of new symlinks.
;;;
;;; Main Features:
;;; - Command-line argument parsing for specifying source and target paths.
;;; - Conflict detection with interactive user resolution options (overwrite or skip).
;;; - Support for symlinking both files and directories.
;;; - Simple and interactive user interface for easy use.
;;;
;;; Usage:
;;;
;;; guile -L . guile-stash.scm --target=<target-dir> --package-dir=<package-dir>
;;;
;;; Replace <target-dir> with the directory where you want the symlink(s) to be created,
;;; and <package-dir> with the path to the source file or directory.
;;;
;;; License:
;;;
;;; ;;; guile-stash.scm --- Description of the script
;;;
;;; Copyright (c) 2024 Glenn Thompson
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining a copy
;;; of this software and associated documentation files (the "Software"), to deal
;;; in the Software without restriction, including without limitation the rights
;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;;; copies of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be included in all
;;; copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;;; SOFTWARE.
;;;
;;; For the full license text, see the LICENSE file.
;;; Code:
;; Import necessary modules
(use-modules (ice-9 getopt-long)
(ice-9 popen) ;; Additional module for executing system commands
(ice-9 rdelim))
;;; ANSI Color Codes for terminal output
(define red-text "\x1b[31m")
(define yellow-text "\x1b[33m")
(define green-text "\x1b[32m")
(define reset-text "\x1b[0m")
;;; Function to wrap messages in color
(define (color-message message color)
(string-append color message reset-text))
(define (shell-quote-argument arg)
(if (string-contains arg " ")
(string-append "\"" (string-replace arg "\"" "\\\"") "\"")
arg))
(define (parse-arguments args)
"Parse command-line arguments."
(let* ((opts (getopt-long args
'((target (value #t) (required? #t))
(package-dir (value #t) (required? #t))))))
opts))
(define (delete-directory path)
(if (file-is-directory? path)
(begin
(system (string-append "rm -r " (shell-quote-argument path)))
#t)
#f))
(define (prompt-user-for-action)
"Prompt the user to decide how to handle a conflict: overwrite (o), skip (s), or rename (r)."
(display (color-message "A conflict was detected. Choose action - Overwrite (o), Skip (s), or Rename (r): " yellow-text))
(let ((response (read-line)))
(cond
((string-ci=? response "o") 'overwrite)
((string-ci=? response "s") 'skip)
((string-ci=? response "r") 'rename)
(else
(display (color-message "Invalid input. " red-text))
(prompt-user-for-action))))) ; Recursive call on invalid input.
(define (handle-conflicts existing-path new-symlink-path)
"Handle conflicts between existing files and new symlinks."
(case (prompt-user-for-action)
((overwrite)
(if (file-is-directory? existing-path)
(delete-directory existing-path) ;; Call the delete-directory function
(delete-file existing-path)) ;; Use Guile's built-in delete-file for files
(symlink new-symlink-path existing-path)
(format #t (color-message (string-append "Existing file/directory overwritten with new symlink: " existing-path " -> " new-symlink-path "\n") green-text)))
((skip)
(display (color-message "Skipped creating new symlink due to conflict.\n" red-text)))
((rename)
;; Prompt for new name and execute renaming
(display (color-message "Enter new name for the existing symlink or file: " yellow-text))
(let ((new-name (read-line)))
(let ((new-path (string-append (dirname existing-path) "/" new-name)))
(rename-file existing-path new-path)
(format #t (color-message (string-append "Renamed " existing-path " to " new-name "\n") green-text)))))
(else
(display (color-message "No valid action selected, no changes made.\n" red-text)))))
(define (create-symlink source target)
"Create a symlink for the source directory at the target location."
(let ((target-symlink-path (string-append target "/" (basename source))))
(if (file-exists? target-symlink-path) ; Checks if the path exists (file, directory, or symlink)
(handle-conflicts target-symlink-path source) ; Handle existing path
(begin
(catch 'system-error
(lambda () (symlink source target-symlink-path)
(display (color-message (string-append "Symlink created for: " target-symlink-path " -> " source "\n") green-text)))
(lambda args
(display (color-message "File exists. Unable to create symlink.\n" red-text))))))))
(define (main args)
"Main function to parse arguments and initiate processing."
(let* ((options (parse-arguments args))
(target-dir (assoc-ref options 'target))
(package-dir (assoc-ref options 'package-dir)))
(if (and target-dir package-dir)
(create-symlink package-dir target-dir)
(begin
(display (color-message "Error: Missing required arguments.\n" red-text))
(display (color-message "Usage: guile stash.scm --target=<target-dir> --package-dir=<package-dir>\n" yellow-text))
(exit 1)))))
;; Entry point for guile-stash
(main (command-line))