videocapture.filehandler - Videocapture

To the Repository
0. Main Page
1. Namespace videocapture.filehandler
2. Types
3. Main module
4. Device detection and mounting
5. File copy helpers
6. Log file and error report handling
7. Local files
8. SMB
9. Complete namespace definition

1 Namespace videocapture.filehandler

2 Types

(s/def ::file (partial instance? java.io.File))
(s/def ::feedback (fn [x] true))
(s/def ::outstream (partial instance? OutputStream))
(s/def ::chan (partial instance? ManyToManyChannel))
(s/def ::atom (partial instance? Atom))
(s/def ::device #(and (string? %) (str/starts-with? % "/dev/")))

3 Main module

(defn init-filehandler []
  (info "Initialisiere Filehandler.")
  (let [killchan (chan)]
    {:killchan killchan
     :device (fsmonitor killchan)}))

(defn stop-filehandler [filehandler]
  (async/put! (:killchan @filehandler) true))

(mount/defstate filehandler
  :start (init-filehandler)
  :stop (stop-filehandler filehandler))

4 Device detection and mounting

(defn fsmonitor [killchan]
  {:pre [(s/valid? ::chan killchan)]
   :post [(s/valid? ::atom %)]}
  (let [device (atom nil)
	ignore (last (str/split-lines (:out (sh/sh "udisksctl" "status"))))]
    (debug "Starte USB-Überwachung, ignoriere" ignore)
    (go-loop [base (last (str/split-lines (:out (sh/sh "udisksctl" "status"))))] 
      (let [line (last (str/split-lines (:out (sh/sh "udisksctl" "status"))))]
	(when-not (or (= base line) (= ignore line))
	  (debug "Found device" line)
	  (gui-util/notification :information "USB-Gerät erkannt" "USB-Gerät erkannt, bereit zum Abspeichern.")
	  (reset! device (str "/dev/" (last (str/split line #" ")) "1"))
	  (when-not (.exists (io/file @device))
	    (reset! device (str "/dev/" (last (str/split line #" "))))))
	(when (= ignore line)
	  (reset! device nil))
	(async/alt!
	  [killchan] nil
	  [(async/timeout 1000)] (recur (if (= base line) base line)))))
    device))

(defn fsmount [device]
  {:pre [(s/valid? ::device device)]}
  (let [mntstr (:out (sh/sh "udisksctl" "mount" "-b" device))]
    (debug mntstr)
    (str/replace (last (str/split mntstr #" at ")) "." "")
    ))

(defn fsumount [device]
  {:pre [(s/valid? ::device device)]}
  (go (debug (:out (sh/sh "sync")))
      (debug (:out (sh/sh "udisksctl" "power-off" "-b" device))))
  ;; (go-loop [umountmsg (:out (sh/sh "udisksctl" "unmount" "-b" device))]
  ;;   (<! (async/timeout 300))
  ;;   (if (= "busy" (last (str/split umountmsg #" ")))
  ;;     (recur (:out (sh/sh "udisksctl" "unmount" "-b" device)))
  ;;     (:out (sh/sh "udisksctl" "power-off" "-b" device))))
  )

5 File copy helpers

(defn output-stream-helper [file]
  ;{:pre [(s/valid? ::file file)]
  ; :post [(s/valid? ::outstream %)]}
  (if (instance? java.io.File file)
    (io/output-stream file)
    (try (new SmbFileOutputStream file)
	 (catch jcifs.smb.SmbAuthException e
	   (gui-util/alert :error "Uploadfehler" "Die Upload-Authorisation ist fehlgeschlagen.")))))

(defn read-file-to-channel [file ch feedback]
  {:pre [(s/valid? ::file file) (s/valid? ::chan ch) (s/valid? ::feedback feedback)]}
  (go
    (with-open [fis (io/input-stream file)]
      (loop [readbytes 0
	     inputbytes (byte-array 8192)]
	(let [inputlength (.read fis inputbytes 0 8192)
	      readbytes (+ readbytes inputlength)]
	  (if (= -1 inputlength)
	    (do (>! ch [nil nil nil])
		(async/close! ch))
	    (do (>! ch [readbytes inputlength inputbytes])
		(recur readbytes (byte-array 8192)))))))))

(defn write-channel-to-file [ch file feedback filelength]
  (go
    (try
      (with-open [fos (output-stream-helper file)]
	(loop [[readbytes inputlength inputbytes] (<! ch)]
	  (if-not (nil? inputbytes)
	    (do (.write fos inputbytes 0 inputlength)
		(>! feedback (* (/ 1.0 filelength) readbytes))
		(recur (<! ch)))
	    (async/close! feedback))))
      (catch Exception e
	(error e)
	(gui-util/notification :error "Fehlgeschlagen" "Der Vorgang ist fehlgeschlagen. Bitte kontaktieren Sie den Helpdesk.")))))

(defn copy-file [from to]
  (let [transfer (chan)
	feedback (chan)]
    (info "Copying file" (pr-str from) "to" (pr-str to))
    (read-file-to-channel from transfer feedback)
    (write-channel-to-file transfer to feedback (.length from))
    feedback))

6 Log file and error report handling

;; GLOBAL VAR HACK
(def video-comment (atom false))

;; LOG FILE SAVE

(defn save-comment-dialog [instance]
  (if (not (or (false? @video-comment) (nil? @video-comment)))
    (do (debug "Feedback is" @video-comment)
	@video-comment)
    (reset! video-comment
	    (fx/run-now (let [dialog (new Dialog)
			      upload-btn (new ButtonType "Ok" ButtonBar$ButtonData/OK_DONE)
			      input (new TextArea)]
			  (.. dialog getDialogPane getButtonTypes (addAll (into-array ButtonType [upload-btn ButtonType/CANCEL])))
			  (.initModality dialog Modality/APPLICATION_MODAL)
			  (.setResizable dialog true)
			  (.setTitle dialog "Datei speichern")
			  (.setHeaderText dialog "Sie haben angegeben, dass mit dem Video etwas nicht stimmt. Bitte präzisieren Sie den Fehler.")
			  (.setContent (.getDialogPane dialog) input)
			  (.setResultConverter dialog (fx/fi javafx.util.Callback [dialogButton]
							     (if (and (= dialogButton upload-btn) (not (str/blank? (.getText input))))
							       (.getText input)
							       false)))
			  (.get (.showAndWait dialog)))))))

(defn prepare-log [instance filename]
  (cond (not (.isSelected (.-videoCorrectBox instance))) (do (save-comment-dialog instance)
							     (if-not (or (false? @video-comment) (nil? @video-comment))
							       (do (info "Userfeedback:" @video-comment)
								   (sh/sh "cp" (str (settings/get-setting :xdg :home) "videocapture.log") filename)
								   true)
							       (do (gui-util/notification :error "Rückmeldung eingeben" "Bitte den Fehler angeben!")
								   false)))
	:else true))

(defn error-report-dialog [instance]
  (info "Preparing error report dialog.")
  (fx/run-now
   (let [dialog (new Dialog)
	 send-btn (new ButtonType "Ok" ButtonBar$ButtonData/OK_DONE)
	 input (new TextArea)]
     (.. dialog getDialogPane getButtonTypes (addAll (into-array ButtonType [send-btn ButtonType/CANCEL])))
     (.initModality dialog Modality/APPLICATION_MODAL)
     (.setTitle dialog "Fehler melden")
     (.setHeaderText dialog "Bitte beschreiben Sie den Fehler so detailliert wie möglich. Eine Logdatei wird automatisch mitgeschickt.")
     (.setResizable dialog true)
     (.setContent (.getDialogPane dialog) input)
     (.setResultConverter dialog (fx/fi javafx.util.Callback [dialogButton]
					(if (= dialogButton send-btn)
					  (.getText input)
					  false)))
     (when-let [report (.get (.showAndWait dialog))]
       (do (info "Usermeldung:" report)
	   (sh/sh "mv" "-f" (str (settings/get-setting :xdg :home) "videocapture.log") (str (settings/get-setting :xdg :home) "errorlog.log"))
	   (go-postal/send-message {:from "videocapture@psy.unibe.ch"
				    :to "helpdesk@psy.unibe.ch"
				    :subject "Fehler bei Videoaufnahme"
				    :body (slurp (str (settings/get-setting :xdg :home) "errorlog.log"))})
	   (sh/sh "rm" "-rf" (str (settings/get-setting :xdg :home) "errorlog.log")))))))

7 Local files

(defn get-free-space [file]
  (if (= 0 (.getFreeSpace file))
    (recur (.getParentFile file))
    (.getFreeSpace file)))

(declare save-video-usb save-video-ptp-old)
(defn save-video-auto [instance filename]
  (if (= (settings/get-setting :gui) "wisc-mainwindow.fxml")
    (save-video-usb instance filename)
    (save-video-ptp-old instance filename)))

(defn save-video-ptp-old [instance filename]
  (go
    (let [filename (str filename (settings/get-setting :C :file-extension))
	  feedbackfile (str filename ".log")
	  source-file (io/file filename)
	  selected-file (io/file (str "/srv/ftp/" (last (str/split filename #"/"))))]
      (cond
	(not (.canWrite (.getParentFile selected-file))) (gui-util/notification :error "Datei nicht schreibbar." "An dieser Stelle kann keine Datei erstellt werden.")
	(> (.length source-file) (get-free-space selected-file)) (gui-util/notification :error "Zu wenig Platz." (str "Auf dem gewählten Datenträger steht nicht genügend Platz zur Verfügung, um die Videodatei (" (format "%.2f" (double (/ (.length source-file) 1024 1024))) " MB) abzuspeichern."))
	:else (do (fx/run-later (.setDisable ^Button (.-saveButton instance) true)
				(.setText (.-statusText instance) "Videodatei speichern..."))
		  (try (go-postal/send-message {:from "videocapture@psy.unibe.ch"
						:to "helpdesk@psy.unibe.ch"
						:subject "Fehler bei Videoaufnahme"
						:body (slurp feedbackfile)})
		       (catch Exception e nil))
		  (try
		    (let [feedback (copy-file source-file selected-file)]
		      (gui-util/mask instance)
		      (loop []
			(if-let [filepercent (<! feedback)]
			  (do (fx/run-later (.setProgress (.-statusBar instance) filepercent)
					    (.setProgress (.-maskerPane instance) filepercent))
			      (recur))
			  (do (fx/run-now (.setProgress (.-maskerPane instance) -1))
			      ;;(<! (fsumount device))
			      (fx/run-later (.setProgress (.-statusBar instance) 0)
					    (.setProgress (.-maskerPane instance) -1)
					    (gui-util/unmask instance)
					    (.setText (.-statusText instance) "Datei gespeichert.")
					    ;;(.play (new AudioClip (.toExternalForm (.toURL (io/file (str (System/getProperty "user.home") "/.videocapture/microwave.wav"))))))
					    (sh/sh "play" "microwave.wav")
					    (gui-util/alert :information "Datei gespeichert." "Die Videodatei wurde erfolgreich gespeichert. Sie können sich jetzt abmelden.") 
					    )))))
		    (catch java.io.IOException e (do (error e)
						     (.setDisable ^Button (.-saveButton instance) false)
						     (.setText (.-statusText instance) "Fehler.")
						     (gui-util/alert :error "Fehler."
								     (str "Es ist ein Fehler aufgetreten. Bitte versuchen Sie es erneut, oder wenden Sie sich an den Helpdesk.\n" (.getLocalizedMessage e)))))
		    ))))))

(defn save-video-usb [instance filename]
  (if (nil? @(:device @filehandler))
    (gui-util/notification :error "USB-Datenträger einstecken" "Bitte den USB-Datenträger einstecken und erneut versuchen.")
    (go (let [ ;; device (<! (fsmonitor))
	      device @(:device @filehandler)
	      initial-directory (-> (fsmount device) str/trim str/trim-newline)
	      extension (settings/get-setting :C :file-extension)
	      feedbackfile (str filename ".log")
	      filename (str filename extension)]
	  (debug initial-directory (io/file initial-directory)) 
	  (when (prepare-log instance feedbackfile)
	    (let [parent (-> instance .-toplevel .getScene .getWindow)
		  source-file (io/file filename)
		  selected-file (io/file (str initial-directory "/" (last (str/split filename #"/"))))]
	      (debug (pr-str selected-file))
	      (debug "Quelldateigrösse:" (.length source-file))
	      (debug "Verfügbarer Speicher auf" (pr-str selected-file) ":" (get-free-space selected-file))
	      (cond
		(not (.canWrite (.getParentFile selected-file))) (gui-util/notification :error "Datei nicht schreibbar." "An dieser Stelle kann keine Datei erstellt werden.")
		(> (.length source-file) (get-free-space selected-file)) (gui-util/notification :error "Zu wenig Platz." (str "Auf dem gewählten Datenträger steht nicht genügend Platz zur Verfügung, um die Videodatei (" (format "%.2f" (double (/ (.length source-file) 1024 1024))) " MB) abzuspeichern."))
		:else (do (fx/run-later (.setDisable ^Button (.-saveButton instance) true)
					(.setText (.-statusText instance) "Videodatei speichern..."))
			  (try (go-postal/send-message {:from "videocapture@psy.unibe.ch"
							:to "helpdesk@psy.unibe.ch"
							:subject "Fehler bei Videoaufnahme"
							:body (slurp feedbackfile)})
			       (catch Exception e nil))
			  (try
			    (let [feedback (copy-file source-file selected-file)]
			      (gui-util/mask instance)
			      (loop []
				(if-let [filepercent (<! feedback)]
				  (do (fx/run-later (.setProgress (.-statusBar instance) filepercent)
						    (.setProgress (.-maskerPane instance) filepercent))
				      (recur))
				  (do (fx/run-now (.setProgress (.-maskerPane instance) -1))
				      (<! (fsumount device))
				      (fx/run-later (.setProgress (.-statusBar instance) 0)
						    (.setProgress (.-maskerPane instance) -1)
						    (gui-util/unmask instance)
						    (.setText (.-statusText instance) "Datei gespeichert.")
						    ;;(.play (new AudioClip (.toExternalForm (.toURL (io/file (str (System/getProperty "user.home") "/.videocapture/microwave.wav"))))))
						    (sh/sh "play" "microwave.wav")
						    (gui-util/alert :information "Datei gespeichert." "Die Videodatei wurde erfolgreich gespeichert. Sie können den USB-Datenträger jetzt entfernen.") 
						    )))))
			    (catch java.io.IOException e (do (error e)
							     (.setDisable ^Button (.-saveButton instance) false)
							     (.setText (.-statusText instance) "Fehler.")
							     (gui-util/alert :error "Fehler."
									     (str "Es ist ein Fehler aufgetreten. Bitte versuche es erneut, oder wende dich an den Helpdesk.\n" (.getLocalizedMessage e)))))
			    )))))))))

8 SMB

(defn smb-upload-video-smb [instance vidpath filename & [nogui?]]
  (let [smb-file (new SmbFile vidpath)
	feedback (copy-file (io/file filename) smb-file)]
    (debug "Hochladen nach" vidpath)
    (when-not nogui?
      (fx/run-later (.setDisable (.-uploadButton instance) true)
		    (gui-util/notification :information "Datei wird hochgeladen." "Die Videodatei wird hochgeladen. Der Fortschritt wird in der Statuszeile angezeigt.")
		    (.setText (.-statusText instance) "Videodatei wird hochgeladen...")
		    (gui-util/mask instance)))
    (go-loop []
      (if-let [filepercent (<! feedback)]
	(do (fx/run-later (.setProgress (.-statusBar instance) filepercent)
			  (.setProgress (.-maskerPane instance) filepercent))
	    (recur))
	(when-not nogui?
	  (fx/run-later (.setProgress (.-statusBar instance) 0)
			(.setProgress (.-maskerPane instance) -1)
			(.setText (.-statusText instance) "Hochladen erfolgreich.")
			;;(.play (new AudioClip (.toExternalForm (.toURL (io/file (str (System/getProperty "user.home") "/.videocapture/microwave.wav"))))))
			(sh/sh "play" "microwave.wav")
			(gui-util/alert :information "Hochladen erfolgreich." "Die Videodatei wurde auf dem Server gespeichert.")
			(gui-util/unmask instance)))))))

(defn smb-upload-video [instance filename]
  (let [group (.getValue (.-groupList instance))
	path (str "smb://" (settings/get-setting :smb :username) ":" (settings/get-setting :smb :password) "@" (settings/get-setting :smb :dns) "/" (settings/get-setting :smb :directory) "/" group "/")
	extension (settings/get-setting :C :file-extension)
	vidfile (str (last (str/split filename #"/")))
	vidpath (str path vidfile)]
    (when (prepare-log instance (str filename ".log"))
      (when-not (.isSelected (.-videoCorrectBox instance))
	(smb-upload-video-smb instance (str vidpath ".log") (str filename ".log") true))
      (smb-upload-video-smb instance (str vidpath extension) (str filename extension)))))

9 Complete namespace definition

(ns videocapture.filehandler
  (:require [clojure.java.io :as io]
	    [clojurefx.clojurefx :as fx]
	    [clojure.core.async :as async :refer [go chan >! <!]]
	    [clojure.string :as str]
	    [clojure.java.shell :as sh]
	    [mount.core :as mount]
	    [postal.core :as go-postal]
	    [videocapture.gui-util :as gui-util]
	    [videocapture.settings :as settings]
	    [videocapture.pipeparser :as recorder]
	    [clojure.core.async :as async :refer [chan <! >! go go-loop]]
	    [taoensso.timbre :as timbre
	     :refer [log trace debug info warn error fatal report
		     logf tracef debugf infof warnf errorf fatalf reportf
		     spy get-env]]
	    [clojure.spec.alpha :as s])
  (:import (jcifs.smb SmbFileOutputStream
		      SmbFile)
	   (org.freedesktop.gstreamer Element)
	   (javafx.stage Modality
			 FileChooser
			 FileChooser$ExtensionFilter)
	   (javafx.scene.control Dialog
				 Button
				 ButtonType
				 ButtonBar$ButtonData
				 Control
				 TextArea)
	   (clojure.core.async.impl.channels ManyToManyChannel)
	   (clojure.lang Atom)
	   (java.io OutputStream)
	   (javafx.scene.media AudioClip)))

<<types>>

<<devices>>

<<mainmodule>>

<<file-copy-helpers>>

<<logfile-handling>>

<<local-files>>

<<smb-files>>

videocapture.filehandler - Videocapture

Table of Contents

1 Namespace videocapture.filehandler

2 Types

3 Main module

4 Device detection and mounting

5 File copy helpers

6 Log file and error report handling

7 Local files

8 SMB

9 Complete namespace definition