| 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); |
| 47 | $DB = DBI->connect("dbi:Pg:host=roadstar;dbname=mdw", "", "", \%opts); |
| 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 | |
| 107 | defcmd "edit GROUP LIST[[+|-]=POS]|-LIST ...", sub { |
| 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 | |
| 126 | OP: for my $op (@ops) { |
| 127 | if ($op =~ /^ - (.++) $/x) { |
| 128 | my ($list) = ($1); |
| 129 | must_list $list; must_member $group, $list; |
| 130 | $st_del->execute($group, $list); |
| 131 | } elsif ($op =~ /^ ((?: [^-+=]++ | [-+][^=])++) |
| 132 | (?: ([-+])?+ = ([-+]?+ \d++))?+ $/x) { |
| 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 | |
| 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; } |
| 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 | |
| 263 | defcmd "list [-g [MARK=]GROUP,...] [-r [LO][-[HI]],...] [-w WIN] LIST", sub { |
| 264 | local @ARGV = @_; |
| 265 | my $bogusp = 0; |
| 266 | my %opt; |
| 267 | getopts("g:r:w:", \%opt) or $bogusp = 1; |
| 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"}; |
| 288 | GROUP: for (@g) { |
| 289 | my ($pre, $g) = /^ (?: (.*?)=)? (.*) $/x; must_group $g; |
| 290 | $st_pos->execute($g, $list); my ($pos) = $st_pos->fetchrow_array; |
| 291 | next GROUP unless defined $pos; |
| 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 | |
| 313 | my @r; |
| 314 | if (defined $opt{"r"}) { |
| 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 | |
| 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 | |
| 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) . ")"; } |
| 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; } |