chiark - git - mdw - dvddb/blob - pldb

   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; }