Commit | Line | Data |
---|---|---|
b2a25885 MW |
1 | #! /usr/bin/perl -w |
2 | ||
3 | use autodie qw{:all}; | |
4 | use open ":utf8"; | |
5 | use strict; | |
6 | ||
7 | use DBI; | |
8 | use Encode qw{encode_utf8 decode_utf8}; | |
9 | use Getopt::Std; | |
10 | ||
11 | BEGIN { | |
12 | binmode STDIN, ":utf8"; | |
13 | binmode STDOUT, ":utf8"; | |
14 | binmode STDERR, ":utf8"; | |
15 | } | |
16 | ||
17 | (my $prog = $0) =~ s:^.*/::; | |
18 | my %CMD_HELP; my %CMD_FN; | |
19 | my $CMD = undef; | |
20 | sub defcmd ($$) { | |
21 | my ($help, $fn) = @_; | |
22 | $help =~ /^(\S+)/ or die "bad usage"; | |
23 | my $cmd = $1; | |
24 | $CMD_HELP{$cmd} = $help; | |
25 | $CMD_FN{$cmd} = $fn; | |
26 | } | |
27 | sub HELP_MESSAGE ($;@) { | |
28 | my ($fh) = @_; | |
29 | if (defined $CMD) { | |
30 | print $fh "usage: $prog $CMD_HELP{$CMD}\n"; | |
31 | } else { | |
32 | print $fh "usage: $prog CMD ARGS ...\n"; | |
33 | for my $cmd (sort keys %CMD_HELP) { print $fh "\t$CMD_HELP{$cmd}\n"; } | |
34 | } | |
35 | } | |
36 | sub bail_usage () { HELP_MESSAGE \*STDERR; exit 2; } | |
37 | ||
38 | my $DB = undef; | |
39 | my $ROOT = "/mnt/dvd/archive"; | |
40 | ||
41 | sub db_connect (;$) { | |
42 | my ($opts) = @_; $opts //= {}; | |
43 | my %opts = (AutoCommit => 0, | |
44 | RaiseError => 1, | |
45 | ReadOnly => 1, | |
46 | %$opts); | |
a2dfdd89 | 47 | $DB = DBI->connect("dbi:Pg:host=roadstar;dbname=mdw", "", "", \%opts); |
b2a25885 MW |
48 | } |
49 | ||
50 | sub must_exist ($$@) { | |
51 | my ($msg, $query, @args) = @_; | |
52 | my $st = $DB->prepare($query); | |
53 | $st->execute(@args); | |
54 | my ($n) = $st->fetchrow_array; $st->finish; | |
55 | $n or die $msg; | |
56 | } | |
57 | sub must_group ($) { | |
58 | my ($group) = @_; | |
59 | must_exist("unknown group `$group'", | |
60 | "SELECT COUNT(*) FROM playlist_group WHERE name = ?", $group); | |
61 | } | |
62 | sub must_list ($) { | |
63 | my ($list) = @_; | |
64 | must_exist("unknown list `$list'", | |
65 | "SELECT COUNT(*) FROM playlist WHERE name = ?", $list); | |
66 | } | |
67 | sub must_member ($$) { | |
68 | my ($group, $list) = @_; | |
69 | must_list $list; | |
70 | must_exist("`$list' is not a member of `$group'", | |
71 | "SELECT COUNT(*) FROM playlist_position | |
72 | WHERE group_name = ? AND list_name = ?", | |
73 | $group, $list); | |
74 | } | |
75 | ||
76 | defcmd "newgroup NAME", sub { | |
77 | @_ == 1 or bail_usage; | |
78 | my ($name) = @_; | |
79 | db_connect { ReadOnly => 0 }; | |
80 | $DB->do("INSERT INTO playlist_group (name) VALUES (?)", undef, $name); | |
81 | }; | |
82 | ||
83 | defcmd "rmgroup NAME", sub { | |
84 | @_ == 1 or bail_usage; | |
85 | my ($name) = @_; | |
86 | db_connect { ReadOnly => 0 }; | |
87 | must_group $name; | |
88 | $DB->do("DELETE FROM playlist_group WHERE name = ?", undef, $name); | |
89 | }; | |
90 | ||
91 | defcmd "groups", sub { | |
92 | @_ == 0 or bail_usage; | |
93 | db_connect; | |
94 | my $st = $DB->prepare("SELECT name FROM playlist_group ORDER BY name"); | |
95 | $st->execute; | |
96 | while (my @r = $st->fetchrow_array) { my ($name) = @r; print "$name\n"; } | |
97 | }; | |
98 | ||
99 | defcmd "lists", sub { | |
100 | @_ == 0 or bail_usage; | |
101 | db_connect; | |
102 | my $st = $DB->prepare("SELECT name FROM playlist ORDER BY name"); | |
103 | $st->execute; | |
104 | while (my @r = $st->fetchrow_array) { my ($name) = @r; print "$name\n"; } | |
105 | }; | |
106 | ||
86ca2191 | 107 | defcmd "edit GROUP LIST[[+|-]=POS]|-LIST ...", sub { |
b2a25885 MW |
108 | @_ >= 2 or bail_usage; |
109 | my ($group, @ops) = @_; | |
110 | ||
111 | db_connect { ReadOnly => 0 }; | |
112 | must_group $group; | |
113 | my $st_chk = $DB->prepare("SELECT n_entry FROM playlist WHERE name = ?"); | |
114 | my $st_getpos = $DB->prepare | |
115 | ("SELECT next_entry FROM playlist_position | |
116 | WHERE group_name = ? AND list_name = ?"); | |
117 | my $st_set = $DB->prepare | |
118 | ("INSERT INTO playlist_position AS p (group_name, list_name, next_entry) | |
119 | VALUES (?, ?, ?) | |
120 | ON CONFLICT (group_name, list_name) | |
121 | DO UPDATE SET next_entry = ? | |
122 | WHERE p.group_name = ? AND p.list_name = ?"); | |
123 | my $st_del = $DB->prepare | |
124 | ("DELETE FROM playlist_position WHERE group_name = ? AND list_name = ?"); | |
125 | ||
9a00b56d | 126 | OP: for my $op (@ops) { |
b2a25885 MW |
127 | if ($op =~ /^ - (.++) $/x) { |
128 | my ($list) = ($1); | |
129 | must_list $list; must_member $group, $list; | |
130 | $st_del->execute($group, $list); | |
86ca2191 MW |
131 | } elsif ($op =~ /^ ((?: [^-+=]++ | [-+][^=])++) |
132 | (?: ([-+])?+ = ([-+]?+ \d++))?+ $/x) { | |
b2a25885 MW |
133 | my ($list, $rel, $pos) = ($1, $2, $3); |
134 | ||
135 | $st_chk->execute($list); | |
136 | my @r = $st_chk->fetchrow_array; @r or die "unknown list `$list'"; | |
137 | my ($n) = @r; $st_chk->finish; | |
138 | ||
139 | $pos //= 0; | |
140 | if (defined $rel) { | |
141 | $st_getpos->execute($group, $list); | |
142 | my @r = $st_getpos->fetchrow_array; | |
143 | @r or die "`$list' is not a member of `$group'"; | |
144 | my ($cur) = @r; $st_getpos->finish; | |
145 | ||
9a00b56d MW |
146 | my $end; |
147 | if ($rel eq "+") { $pos = $cur + $pos; $end = $n; } | |
148 | elsif ($rel eq "-") { $pos = $cur - $pos; $end = 0; } | |
149 | if ($pos == $end) { $st_del->execute($group, $list); next OP; } | |
b2a25885 MW |
150 | } |
151 | 0 <= $pos && $pos < $n | |
152 | or die "`$list' position $pos out of range 0 .. $n"; | |
153 | $st_set->execute($group, $list, $pos, | |
154 | $pos, $group, $list); | |
155 | } else { | |
156 | die "bad edit op `$op'"; | |
157 | } | |
158 | } | |
159 | }; | |
160 | ||
161 | defcmd "next [-pu] [-o N] [-n N] GROUP [LIST]", sub { | |
162 | local @ARGV = @_; | |
163 | my $bogusp = 0; | |
164 | my %opt; | |
165 | getopts("o:n:pu", \%opt) or $bogusp = 1; | |
166 | 1 <= @ARGV && @ARGV <= 2 or $bogusp = 1; | |
167 | !defined $opt{"o"} || $opt{"o"} =~ /^[-+]?\d+$/ or $bogusp = 1; | |
168 | !defined $opt{"n"} || $opt{"n"} =~ /^\d+$/ or $bogusp = 1; | |
169 | my $o = $opt{"o"} // 0; | |
170 | my $n = $opt{"n"} // 1; | |
171 | if ($bogusp) { bail_usage; } | |
172 | my ($group, $list) = @ARGV; | |
173 | ||
174 | db_connect; | |
175 | must_group $group; | |
176 | defined $list and must_member $group, $list; | |
177 | ||
178 | my $glen = 0; | |
179 | if (!defined $list) { | |
180 | my $st = $DB->prepare | |
181 | ("SELECT MAX(LENGTH(list_name)) | |
182 | FROM playlist_position | |
183 | WHERE group_name = ?"); | |
184 | $st->execute($group); ($glen) = $st->fetchrow_array; $st->finish; | |
185 | } | |
186 | ||
187 | my %elen; my $elen_max = -1; | |
188 | if ($opt{"p"}) { | |
189 | my $q = | |
190 | "SELECT p.list_name, MAX(e.entry) | |
191 | FROM playlist_entry AS e | |
192 | JOIN playlist_position AS p ON e.list_name = p.list_name | |
193 | WHERE p.group_name = ? AND | |
194 | p.next_entry + ? <= e.entry AND e.entry < p.next_entry + ?"; | |
195 | my @arg = ($group, $o, $n + $o); | |
196 | if (defined $list) { $q .= " AND p.list_name = ?"; push @arg, $list; } | |
197 | $q .= " GROUP BY p.list_name"; | |
198 | my $st = $DB->prepare($q); $st->execute(@arg); | |
199 | while (my @r = $st->fetchrow_array) { | |
200 | my ($l, $emax) = @r; | |
201 | my $elen = $elen{$l} = defined $emax ? length $emax : -1; | |
202 | $elen > $elen_max and $elen_max = $elen; | |
203 | } | |
204 | } | |
205 | ||
206 | my $q = | |
207 | "SELECT p.list_name, p.next_entry, e.entry, c.n, s.title, m.title, | |
208 | m.path, m.title_number, m.start_chapter, m.end_chapter | |
209 | FROM playlist_position AS p | |
210 | JOIN playlist_entry AS e ON p.list_name = e.list_name | |
211 | JOIN media AS m ON e.media_id = m.id | |
212 | JOIN series AS s ON m.series_name = s.name | |
213 | JOIN (SELECT t.list_name, COUNT(*) AS n | |
214 | FROM (SELECT DISTINCT e.list_name, m.series_name AS series_name | |
215 | FROM playlist_entry AS e | |
216 | JOIN media AS m ON e.media_id = m.id) AS t | |
217 | GROUP BY t.list_name) AS c | |
218 | ON e.list_name = c.list_name | |
219 | WHERE p.group_name = ? AND | |
220 | p.next_entry + ? <= e.entry AND e.entry < p.next_entry + ?"; | |
221 | my @arg = ($group, $o, $n + $o); | |
222 | if (defined $list) { $q .= " AND p.list_name = ?"; push @arg, $list; } | |
223 | $q .= " ORDER BY p.list_name ASC, e.entry ASC"; | |
224 | my $st_query = $DB->prepare($q); $st_query->execute(@arg); | |
225 | my $prevlist = undef; | |
226 | my @out; | |
227 | ||
228 | while (my @r = $st_query->fetchrow_array) { | |
229 | my ($l, $pos, $i, $nseries, $stitle, $title, | |
230 | $path, $ttn, $loch, $hich) = @r; | |
231 | my $out; | |
232 | if (!$opt{"u"}) { | |
233 | $out = $nseries == 1 ? $title : "$stitle $title"; | |
234 | } else { | |
235 | my $scheme = $path =~ /\.iso$/ ? "dvd" : "file"; | |
236 | my $frag; | |
237 | if ($ttn == -1) { $frag = ""; } | |
238 | elsif ($loch == -1) { $frag = "#$ttn"; } | |
239 | elsif ($hich == -1) { $frag = "#$ttn:$loch"; } | |
240 | else { my $hi = $hich - 1; $frag = "#$ttn:$loch-$ttn:$hi"; } | |
241 | $path = encode_utf8 $path; | |
242 | $path =~ s:([^-_\w.,!\$\%/]):sprintf "%%%02x", ord $1:eg; | |
243 | $out = "$scheme://$ROOT/$path$frag"; | |
244 | } | |
245 | if ($opt{"p"}) { | |
246 | my $pos = "[$i]"; | |
247 | $out = sprintf "%*s %s", | |
248 | ($n == 1 ? $elen_max : $elen{$l}) + 2, $pos, $out; | |
249 | } | |
250 | if ($n > 1) { $out = ($i == $pos ? "> " : " ") . $out; } | |
251 | if (defined $list) { print $out, "\n"; } | |
252 | elsif ($n == 1) { printf "%-*s %s\n", $glen, $l, $out; } | |
253 | elsif (!defined $prevlist) { $prevlist = $l; @out = ($out); } | |
254 | elsif (defined $prevlist && $l eq $prevlist) { push @out, $out; } | |
255 | else { | |
256 | print "$prevlist\n", map("\t$_\n", @out), "\n"; | |
257 | $prevlist = $l; @out = ($out); | |
258 | } | |
259 | } | |
260 | defined $prevlist and print "$prevlist\n", map "\t$_\n", @out; | |
261 | }; | |
262 | ||
ecc6b492 | 263 | defcmd "list [-g [MARK=]GROUP,...] [-r [LO][-[HI]],...] [-w WIN] LIST", sub { |
b2a25885 MW |
264 | local @ARGV = @_; |
265 | my $bogusp = 0; | |
266 | my %opt; | |
ecc6b492 | 267 | getopts("g:r:w:", \%opt) or $bogusp = 1; |
b2a25885 MW |
268 | @ARGV == 1 or $bogusp = 1; |
269 | if ($bogusp) { bail_usage; } | |
270 | my ($list) = @ARGV; | |
271 | ||
272 | db_connect; | |
273 | must_list $list; | |
274 | my $st_nseries = $DB->prepare | |
275 | ("SELECT COUNT(*) FROM | |
276 | (SELECT DISTINCT m.series_name | |
277 | FROM playlist_entry AS e JOIN media AS m ON e.media_id = m.id | |
278 | WHERE e.list_name = ?) AS _"); | |
279 | my $st_pos = $DB->prepare | |
280 | ("SELECT p.next_entry FROM playlist_position AS p | |
281 | WHERE p.group_name = ? AND p.list_name = ?"); | |
282 | $st_nseries->execute($list); | |
283 | my ($nseries) = $st_nseries->fetchrow_array; $st_nseries->finish; | |
284 | ||
285 | my %pos; my $plen = -1; | |
286 | if (defined $opt{"g"}) { | |
287 | my @g = split /,/, $opt{"g"}; | |
ecc6b492 | 288 | GROUP: for (@g) { |
b2a25885 MW |
289 | my ($pre, $g) = /^ (?: (.*?)=)? (.*) $/x; must_group $g; |
290 | $st_pos->execute($g, $list); my ($pos) = $st_pos->fetchrow_array; | |
ecc6b492 | 291 | next GROUP unless defined $pos; |
b2a25885 MW |
292 | my $t = $pos{$pos} = |
293 | (exists $pos{$pos} ? $pos{$pos} . "," : "") . | |
294 | ($pre // (@g == 1 ? "" : $g)); | |
295 | length $t > $plen and $plen = length $t; | |
296 | } | |
297 | } | |
298 | ||
299 | my $st_elen = $DB->prepare | |
300 | ("SELECT MAX(entry) FROM playlist_entry WHERE list_name = ?"); | |
301 | $st_elen->execute($list); | |
302 | my ($emax) = $st_elen->fetchrow_array; $st_elen->finish; | |
303 | my $elen = length $emax; | |
304 | ||
305 | my $q = | |
306 | "SELECT e.entry, s.title, m.title | |
307 | FROM playlist_entry AS e | |
308 | JOIN media AS m ON e.media_id = m.id | |
309 | JOIN series AS s ON m.series_name = s.name | |
310 | WHERE e.list_name = ?"; | |
311 | my @arg = ($list); | |
312 | ||
3a88aeaf | 313 | my @r; |
b2a25885 | 314 | if (defined $opt{"r"}) { |
3a88aeaf MW |
315 | for my $r (split /,/, $opt{"r"}) { |
316 | $r =~ /^ (\d+)? (?: - (\d+)?)? $/x | |
317 | or die "invalid range expression `$r'"; | |
318 | my ($lo, $hi) = ($1 // 0, $2 // $emax + 1); | |
319 | $hi <= $emax or $hi = $emax + 1; | |
320 | push @r, [$lo, $hi]; | |
321 | } | |
322 | } | |
323 | ||
ecc6b492 MW |
324 | if (defined $opt{"w"}) { |
325 | (my $w = $opt{"w"}) =~ /^\d+$/ or die "bad window size `$opt{w}'"; | |
326 | %pos or die "no positions"; | |
327 | for my $pos (keys %pos) { push @r, [$pos - $w, $pos + $w + 1] } | |
328 | } | |
329 | ||
3a88aeaf MW |
330 | if (@r) { |
331 | my ($curr_lo, $curr_hi) = (undef, undef); | |
332 | my @newr; | |
333 | RANGE: for my $r (sort { $a->[0] <=> $b->[0] || | |
334 | $a->[1] <=> $b->[1] } @r) { | |
335 | my ($lo, $hi) = @$r; | |
336 | if (defined $curr_hi) { | |
337 | if ($lo <= $curr_hi) { $curr_hi = $hi; next RANGE; } | |
338 | push @newr, [$curr_lo, $curr_hi]; | |
339 | } | |
340 | ($curr_lo, $curr_hi) = ($lo, $hi); | |
341 | } | |
342 | push @newr, [$curr_lo, $curr_hi]; | |
343 | my @q; | |
344 | for my $r (@newr) { | |
345 | my ($lo, $hi) = @$r; | |
346 | my @qr; | |
347 | if ($lo > 0) { push @qr, "? <= e.entry"; push @arg, $lo; } | |
348 | if ($hi <= $emax ) { push @qr, "e.entry < ?"; push @arg, $hi; } | |
349 | if (!@qr) { } | |
350 | elsif (@qr == 1) { push @q, @qr; } | |
351 | else { push @q, "(" . join(" AND ", @qr) . ")"; } | |
352 | } | |
353 | if (@q == 1) { $q .= " AND $q[0]"; } | |
354 | else { $q .= " AND (" . join(" OR ", @q) . ")"; } | |
b2a25885 MW |
355 | } |
356 | ||
357 | $q .= " ORDER BY e.entry ASC"; | |
358 | my $st_list = $DB->prepare($q); $st_list->execute(@arg); | |
359 | my $msep = $plen < 0 ? "" : " "; | |
360 | while (my @r = $st_list->fetchrow_array) { | |
361 | my ($i, $stitle, $title) = @r; | |
362 | $nseries == 1 or $title = "$stitle $title"; | |
363 | my $m = exists $pos{$i} ? "$pos{$i}>" : ""; | |
364 | printf "%*s%s%*s %s\n", $plen + 1, $m, $msep, $elen + 2, "[$i]", $title; | |
365 | } | |
366 | }; | |
367 | ||
368 | my $bogusp = 0; | |
369 | my %opt; | |
370 | getopts("h", \%opt) or $bogusp = 1; | |
371 | if ($opt{"h"}) { HELP_MESSAGE \*STDOUT; exit 0; } | |
372 | @ARGV >= 1 or $bogusp = 1; | |
373 | if ($bogusp) { bail_usage; } | |
374 | ||
375 | $CMD = shift; $CMD_FN{$CMD} or die "unknown command `$CMD'"; | |
376 | $CMD_FN{$CMD}(@ARGV); | |
377 | if (defined $DB) { $DB->commit; $DB->disconnect; } |