#!/usr/bin/guile !# ;;; (C) Copyright 2016 by louis@gnusocial.club ;;; I hereby place this into the public domain ;;; ;;; Advertising: for help with the GNU operating system running with ;;; the Linux kernel contact http://gnu.support ;;; ;;; This program helps with the creation of the file for the batch ;;; upload images and videos to GNU Mediagoblin database. Please see ;;; about the MediaGoblin here: http://mediagoblin.org/ ;;; ;;; It shall be run with files to be described on the command line ;;; Do not expect it to be perfect. It prepairs the batch file for you ;;; but you better be smart and edit the batch file for correctness ;;; ;;; Configuration ;;; ;;; define here your main program to view videos and images ;;; I don't know what is it on your side, maybe xdg-open I cannot know... (define rcd-media-viewer "rox") ;;; Define here your username for mediagoblin (define gmg-user "mediasyogm") ;;; this is the name of your batch file, you will transfer the batch ;;; file and the media, images, videos on your MediaGoblin server and ;;; you will later run your batch file to quickly insert media into ;;; your MediaGoblin (define gmg-description-file "gmg-batch.sh") ;;; Define the default license (define default-license "http://creativecommons.org/licenses/by-sa/3.0/") ;;; we start here, and load few modules (use-modules (ice-9 ftw)) (use-modules (ice-9 rdelim)) (use-modules (ice-9 readline)) (use-modules (ice-9 regex)) ;;; it should be clear, that if no media is specified on the command ;;; line that program shall not run, it quits. (if (null? (cdr (program-arguments))) (begin (display "No files specified.\n") (quit))) ;;; files-to-describe is the list of files on the command line (define files-to-describe (cdr (program-arguments))) ;;; this function will check if files are readable (define rcd-can-read-file (lambda(file) (if (not (access? file R_OK)) (begin (display (string-append "Cannot read the file: " file "\nABORTED\n")) (quit))))) ;;; we run through the list and check if each of files are readable (for-each rcd-can-read-file files-to-describe) ;;; we will only append to the file, and not overwrite it, that is "a" ;;; in this definition (define gmg-port (open-file gmg-description-file "a")) (define ask-question (lambda(question) (set-readline-prompt! question) (let ((answer "")) (set! answer (readline)) answer))) ;;; TODO: trim - from both sides (define rcd-make-slug (lambda(slug) (string-downcase (regexp-substitute/global #f " " slug 'pre "-" 'post)))) (define rcd-trim-and-quote (lambda(s) (string-append "\"" (string-trim-both s) "\""))) (define rcd-trim-tags (lambda(s) (string-join (map string-trim-both (string-split s #\,)) ","))) (define gmg-ask-questions (lambda (file) (display (string-append "\n\nFILE: " file "\n")) (let ((title (string-capitalize! (ask-question "Title: "))) (description (string-upcase (ask-question "Description: ") 0 1)) ;; (license (ask-question "License: ")) (tags (rcd-trim-tags (ask-question "Tags: "))) (slug (rcd-make-slug (ask-question "Slug: ")))) (string-append "./bin/gmg addmedia " gmg-user " gmg/" file " --title \"" title "\"" " --description \"" description "\"" " --license \"" default-license "\"" " --tags \"" tags "\"" " --slug \"" slug "\"")))) (define rcd-trim-and-quote-list (lambda(s) (for-each rcd-trim-and-quote s))) (define gmg-ask-and-write (lambda (file) (system (string-append rcd-media-viewer " " file)) (write-line (gmg-ask-questions file) gmg-port))) (for-each gmg-ask-and-write files-to-describe) (close-output-port gmg-port)