~mdw / dvddb / blame
| 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; } |