trmote/transmission-labels.scm at main · siiky/trmote · GitHub

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
;;; TODO:
;;; - [ ] Consistent error handling
;;; - [ ] Create a base procedure that does all the heavy lifting

(import
  chicken.process-context
  chicken.string
  chicken.port)

(import
  cling
  (only srfi-1
        any
        lset-difference
        lset-union
        member)
  typed-records)

(import
  transmission
  transmission.utils)

(include "connection-options.scm")

(define-constant *HELP-TEXT*
#<<EOF
transmission-labels add    TORRENTS LABELS ...
transmission-labels get    TORRENTS
transmission-labels remove TORRENTS LABELS ...
transmission-labels set    TORRENTS [LABELS ...]

`add` adds the given LABELS to the specified TORRENTS.
`get` lists the labels associated with the specified TORRENTS.
`remove` removes the given LABELS from the specified TORRENTS.
`set` sets the given LABELS for the specified TORRENTS.

`add` and `remove` have no effect when called with no labels.
To remove all labels just call `set` with no labels.

EOF
)

(define (help* . _)
  (help *connection-opts*)
  (print *HELP-TEXT*)
  (exit 1))

(define (torrent-ids-string->transmission-ids str)
  (define (hash/id-string->hash/id str)
    (if (= (string-length str) 40)
        str
        (string->number str)))

  (cond
    ((string=? str "all")
     #f)
    ((member str '("active" "recently-active") string=?)
     "recently-active")
    (else
      (let ((ret (map hash/id-string->hash/id (string-split str "," #t))))
        (if (any not ret)
            '()
            ret)))))

(define ((add/remove op) torrents labels-to-add/remove)
  (unless (null? labels-to-add/remove)
    (let ((torrents (torrent-ids-string->transmission-ids torrents)))
      (unless (null? torrents)
        (with-transmission-result (torrent-get '("hashString" "labels") #:ids torrents)
                                  (lambda (arguments . _)
                                    (alist-let/and arguments (torrents)
                                                   (for-each
                                                     (lambda (torrent)
                                                       (alist-let/and torrent ((hash-string hashString) labels)
                                                                      (let ((labels (op string=? (vector->list labels) labels-to-add/remove)))
                                                                        (with-transmission-result (torrent-set #:ids hash-string #:labels labels)
                                                                                                  (lambda _ print "Success!")
                                                                                                  (lambda (result/con . _)
                                                                                                    (if (condition? result/con)
                                                                                                        (print-error-message result/con (current-output-port) "Failed:")
                                                                                                        (print "Failed: " result/con)))))))
                                                     (vector->list torrents)))))))))

(define (add torrents . labels-to-add)
  ((add/remove lset-union) torrents labels-to-add))

(define (get torrents . rest)
  (unless (null? rest)
    (help*))

  (let ((torrents (torrent-ids-string->transmission-ids torrents)))
    (unless (null? torrents)
      (with-transmission-result (torrent-get '("id" "hashString" "labels") #:ids torrents)
                                (lambda (arguments . _)
                                  (alist-let/and arguments (torrents)
                                                 (print "Hash                                    \tID\tLabels")
                                                 (for-each
                                                   (lambda (torrent)
                                                     (alist-let/and torrent (id (hash-string hashString) labels)
                                                                    (print hash-string #\tab id #\tab labels)))
                                                   (vector->list torrents))))))))

(define (remove torrents . labels-to-remove)
 ((add/remove lset-difference) torrents labels-to-remove))

(define (set torrents . labels)
  (let ((torrents (torrent-ids-string->transmission-ids torrents)))
    (unless (null? torrents)
      (torrent-set #:ids torrents #:labels labels))))

(define (main args)
  (let-values (((args help?) (update-connection-options! args)))
    (if (or help?
            (null? args)
            (null? (cdr args)))
      (help*)
      (apply (alist-ref (car args)
                        `(("add"    . ,add)
                          ("get"    . ,get)
                          ("remove" . ,remove)
                          ("set"    . ,set))
                        string=?
                        help*)
             (cdr args)))))

(main (command-line-arguments))