~yoctocell/peertube

ref: 423946a0da88e56ed97d2762a60e4d650a8aa476 peertube/peertube.el -rw-r--r-- 12.5 KiB
423946a0 — yoctocell Implement function to remove nsfw content 1 year, 11 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
;;; peertube.el --- Query PeerTube videos in Emacs -*- lexical-binding: t; -*-

;; Copyright (C) 2020 yoctocell

;; Author: yoctocell <public@yoctocell.xyz>
;; Version: 0.3.0
;; Keywords: peertube multimedia
;; URL: https://git.sr.ht/~yoctocell/peertube
;; License: GNU General Public License >= 3
;; Package-Requires: ((emacs "25.3") (transmission "0.12.1"))

;; 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 of the License, 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:
;;
;; This package provides an interface to search for PeerTube videos
;; and lists the results in a buffer as a tabulated list.
;;
;; peertube.el queries https://sepiasearch.org/, the official search
;; engine for PeerTube.  Learn more at https://joinpeertube.org/.

;;; Code:

(require 'json)
(require 'cl-lib)
(require 'cl-seq)
(require 'transmission)

(defvar peertube-videos '()
  "List of videos displayed in the *peertube* buffer.")

(defvar peertube-search-term ""
  "Current peertube search term.")

(defgroup peertube nil
  "Query PeerTube videos in Emacs."
  :group 'convenience)

(defcustom peertube-disable-nsfw t
  "Whether to disable NSFW content."
  :type 'boolean
  :group 'peertube)

(defcustom peertube-video-resolutions '(720 1080 480 360)
  "List of available resolutions for videos in `peetube'.

The order matters, the first one will be the default choice.
Note: Not all resolutions are available for att videos."
  :type 'list
  :group 'peertube)

(defcustom peertube-channel-length 15
  "Length of the creator of the video."
  :type 'integer
  :group 'peertube)

(defcustom peertube-title-length 50
  "Length of the title of the video."
  :type 'integer
  :group 'peertube)

(defcustom peertube-sort-method 'relevance
  "How to sort search results."
  :type 'symbol
  :options '(relevance most-recent least-recent)
  :group 'peertube)

(defface peertube-channel-face
  '((t :inherit font-lock-variable-name-face))
  "Face used for the channel.")

(defface peertube-date-face
  '((t :inherit font-lock-string-face))
  "Face used for the date of upload.")

(defface peertube-duration-face
  '((t :inherit error))
  "Face used for the duration.")

(defface peertube-tags-face
  '((t :inherit font-lock-constant-face))
  "Face used for the tags.")

(defface peertube-title-face
  '((t :inherit font-lock-type-face))
  "Face used for the video title.")

(defface peertube-views-face
  '((t :inherit font-lock-builtin-face))
  "Face used for the view count.")

(define-derived-mode peertube-mode tabulated-list-mode "peertube"
  "Major mode for peertube.")

(defvar peertube-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "o" 'peertube-open-video)
    (define-key map "s" 'peertube-search)
    (define-key map "d" 'peertube-download-video)
    (define-key map "g" 'peertube-draw-buffer)
    (define-key map "n" 'next-line)
    (define-key map "p" 'previous-line)
    map)
  "Keymap for `peertube-mode'.")

(defun peertube-quit ()
  "Close peertube buffer."
  (interactive)
  (quit-window))

(defun peertube--remove-nsfw (video)
  "Remove VIDEO if marked as NSFW."
  (let ((nsfw (peertube-video-nsfw video)))
    (if (eq nsfw t)
	nil
      video)))

(defun peertube--format-channel (channel)
  "Format the CHANNEL name in the *peertube* buffer."
  (propertize channel 'face `(:inherit peertube-channel-face)))

(defun peertube--format-date (date)
  "Format the DATE in the *peertube* buffer."
  (propertize (seq-take date 10) 'face `(:inherit peertube-date-face)))

(defun peertube--format-duration (duration)
  "Format the DURATION from seconds to hh:mm:ss in the *peertube* buffer."
  (let ((formatted-string (concat (format-seconds "%.2h" duration)
				  ":"
				  (format-seconds "%.2m" (mod duration 3600))
				  ":"
				  (format-seconds "%.2s" (mod duration 60))
				  "  ")))
    (propertize formatted-string 'face `(:inherit peertube-duration-face))))

(defun peertube--format-tags (tags)
  "Format the TAGS in the *peertube* buffer."
  (let ((formatted-string (if (eq (length tags) 0)
			      (format "")
			    (format "%s" tags))))
    (propertize formatted-string 'face `(:inherit peertube-tags-face))))

(defun peertube--format-title (title)
  "Format the video TITLE int the *peertube* buffer."
  (propertize title 'face `(:inherit peertube-title-face)))

(defun peertube--format-views (views)
  "Format the VIEWS in the *peertube* buffer.

Format to thousands (K) or millions (M) if necessary."
  (let ((formatted-string
	 (cond ((< 1000000 views)
		(format "%5sM" (/ (round views 100000) (float 10))))
	       ((< 1000 views)
		(format "%5sK" (/ (round views 100) (float 10))))
	       (t (format "%6s" views)))))
    (propertize formatted-string 'face `(:inherit peertube-views-face))))

(defun peertube--insert-entry (video)
  "Insert VIDEO into the current buffer."
  (list (peertube-video-url video)
	(vector (peertube--format-duration (peertube-video-duration video))
		(peertube--format-title (peertube-video-title video))
		(peertube--format-channel (peertube-video-channel video))
		(peertube--format-date (peertube-video-date video))
		(peertube--format-views (peertube-video-views video))
		(peertube--format-tags (peertube-video-tags video)))))

(defun peertube-draw-buffer ()
  "Draw buffer with video entries."
  (interactive)
  (read-only-mode -1)
  (erase-buffer)
  (read-only-mode 1)
  (setq tabulated-list-format `[("Duration" 10 t)
				("Title" ,peertube-title-length t)
				("Channel" ,peertube-channel-length t)
				("Date" 10 t)
				("Views" 6 t)
				("Tags" 10 nil)])
  (setq tabulated-list-entries (mapcar 'peertube--insert-entry
				       peertube-videos))
  (tabulated-list-init-header)
  (tabulated-list-print))

(defun peertube--get-current-video ()
  "Get the currently selected video."
  (aref peertube-videos (1- (line-number-at-pos))))

(defun peertube-download-video ()
  "Download the video under the cursor using `transmission-add'."
  (interactive)
  (let* ((url (peertube-video-url (peertube--get-current-video)))
	 (res (completing-read "Resolution of video: "
			       (mapcar 'number-to-string peertube-video-resolutions)))
	 (torrent-link (replace-regexp-in-string
			"https://\\(.*\\)/videos/watch/\\(.*$\\)"
			(concat "https://\\1/download/torrents/\\2-"
				res
				".torrent")
			url)))
    (message torrent-link)
    (transmission-add torrent-link))
  (message "Downloading video..."))

(defun peertube-open-video ()
  "Open the video under the cursor using `browse-url'."
  (interactive)
  (let ((url (peertube-video-url (peertube--get-current-video))))
    (browse-url url)))

(defun peertube-goto-channel ()
  "Go to the channel page of the current video."
  (interactive)
  (let ((url (peertube-video-channelUrl (peertube--get-current-video))))
    (browse-url url)))

(defun peertube-preview-thumbnail ()
  "View the thumbnail of the current video."
  (interactive)
  (let ((url (peertube-video-thumbnailUrl (peertube--get-current-video)))
	(temp-file (make-temp-file "thumbnail")))
    (progn
      (call-process "curl" nil nil nil url "-o" temp-file)
      (find-file temp-file)
      (image-transform-set-scale 4))))

(defun peertube-show-video-info ()
  "Show more information about video under point."
  (interactive)
  (let ((title (concat "Title: " (peertube-video-title (peertube--get-current-video)) "\n"))
	(channel (concat "Channel: " (peertube-video-channel (peertube--get-current-video)) "\n"))
	(date (concat "Published: " (peertube-video-date (peertube--get-current-video)) "\n"))
	(views (concat "Views: " (number-to-string (peertube-video-views (peertube--get-current-video))) "\n"))
	(duration (concat "Duration: " (number-to-string (peertube-video-duration (peertube--get-current-video))) "\n"))
	(likes (concat "Likes: " (number-to-string (peertube-video-likes (peertube--get-current-video))) "\n"))
	(dislikes (concat "Dislikes: " (number-to-string (peertube-video-dislikes (peertube--get-current-video))) "\n"))
	(description (concat "Description\n" (peertube-video-description (peertube--get-current-video)))))
    (switch-to-buffer "*peertube-info*")
    (with-current-buffer "*peertube-info*"
      (erase-buffer)
      (insert
       (concat title channel date views duration likes dislikes description)))))

(defun peertube-change-sort-method ()
  "Change sorting method used for `peertube' and update the results buffer."
  (interactive)
  (let ((method (intern (completing-read "PeerTube sorting method: "
					 peertube-sort-methods))))
    (setq peertube-sort-method method))
  (peertube-search peertube-search-term))

(defun peertube-search (query)
  "Search PeerTube for QUERY."
  (interactive "sSearch PeerTube: ")
  (let ((videos (if peertube-disable-nsfw
		    (cl-remove-if #'null (mapcar 'peertube--remove-nsfw (peertube-query query)))
		  (peertube-query query))))
    (setq peertube-videos videos))
  (setq peertube-search-term query)
  (peertube-draw-buffer))

;; Store metadata for PeerTube videos
(cl-defstruct (peertube-video (:constructor peertube--create-video)
			      (:copier nil))
  "Metadata for a PeerTube video."
  (title "" :read-only t)
  (account "" :read-only t)
  (accountUrl "" :read-only t)
  (channel "" :read-only t)
  (channelUrl "" :read-only t)
  (date "" :read-only t)
  (category "" :read-only t)
  (language "" :read-only t)
  (duration 0 :read-only t)
  (tags [] :read-only t)
  (url "" :read-only t)
  (views 0 :read-only t)
  (likes 0 :read-only t)
  (dislikes 0 :read-only t)
  (nsfw nil :read-only t)
  (thumbnailUrl "" :read-only t)
  (description "" :read-only t)
  (host "" :read-only t))

(defun peertube--get-sort-method ()
  "Given a sorting method SORT, return the 'real' name of the method."
  (cond ((eq peertube-sort-method 'least-recent) "publishedAt")
	((eq peertube-sort-method 'most-recent) "-publishedAt")
	(t "-match")))

(defun peertube--pre-process-query (query)
  "Remove spaces in QUERY to make them api friendly."
  (replace-regexp-in-string "\\s-" "%20" query))

(defun peertube--call-api (query)
  "Call the PeerTube search API with QUERY as the search term.

Curl is used to call 'search.joinpeertube.org', the result gets
parsed by `json-read'."
  (let ((sort (peertube--get-sort-method))
	(query (peertube--pre-process-query query)))
    (with-temp-buffer
      (call-process "curl" nil t nil "--silent" "-X" "GET"
		    (concat
		     "https://sepiasearch.org/api/v1/search/videos?search="
		     query "&sort=" sort "&page=1"))
      (goto-char (point-min))
      ;; ((total . [0-9]{4}) (data . [(... ... ...) (... ... ...) ...]))
      ;;                             └───────────────────────────────┘
      ;;                                   extract useful data
      (cdr (car (cdr (json-read)))))))

(defun peertube-query (query)
  "Query PeerTube for QUERY and parse the results."
  (interactive)
  (let ((videos (peertube--call-api query)))
    (dotimes (i (length videos))
      (let ((v (aref videos i)))
	(aset videos i
	      (peertube--create-video
	       :title (assoc-default 'name v)
	       :account (assoc-default 'name (assoc-default 'account v))
	       :accountUrl (assoc-default 'url (assoc-default 'account v))
	       :channel (assoc-default 'name (assoc-default 'channel v))
	       :channelUrl (assoc-default 'url (assoc-default 'channel v))
	       :date (assoc-default 'publishedAt v)
	       :category (assoc-default 'label (assoc-default 'category v))
	       :language (assoc-default 'label (assoc-default 'language v))
	       :duration (assoc-default 'duration v)
	       :tags (assoc-default 'tags v)
	       :url (assoc-default 'url v)
	       :views (assoc-default 'views v)
	       :likes (assoc-default 'likes v)
	       :dislikes (assoc-default 'dislikes v)
	       :nsfw (assoc-default 'nsfw v)
	       :thumbnailUrl (assoc-default 'thumbnailUrl v)
	       :description (assoc-default 'description v)
	       :host (assoc-default 'host (assoc-default 'channel v))))))
    videos))


;;;###autoload
(defun peertube ()
  "Open the '*peertube*' buffer."
  (interactive)
  (switch-to-buffer "*peertube*")
  (unless (eq major-mode 'peertube-mode)
    (peertube-mode)
    (call-interactively 'peertube-search)))

(provide 'peertube)

;;; peertube.el ends here