X-Git-Url: https://git.distorted.org.uk/~mdw/dvddb/blobdiff_plain/75a5b9248f89fd40189035093b751a7bbcd0292d..b2a25885cb81761a2b33014a00f843e76f4ce83c:/pldb

diff --git a/pldb b/pldb
new file mode 100755
index 0000000..2a16fe5
--- /dev/null
+++ b/pldb
@@ -0,0 +1,337 @@
+#! /usr/bin/perl -w
+
+use autodie qw{:all};
+use open ":utf8";
+use strict;
+
+use DBI;
+use Encode qw{encode_utf8 decode_utf8};
+use Getopt::Std;
+
+BEGIN {
+  binmode STDIN, ":utf8";
+  binmode STDOUT, ":utf8";
+  binmode STDERR, ":utf8";
+}
+
+(my $prog = $0) =~ s:^.*/::;
+my %CMD_HELP; my %CMD_FN;
+my $CMD = undef;
+sub defcmd ($$) {
+  my ($help, $fn) = @_;
+  $help =~ /^(\S+)/ or die "bad usage";
+  my $cmd = $1;
+  $CMD_HELP{$cmd} = $help;
+  $CMD_FN{$cmd} = $fn;
+}
+sub HELP_MESSAGE ($;@) {
+  my ($fh) = @_;
+  if (defined $CMD) {
+    print $fh "usage: $prog $CMD_HELP{$CMD}\n";
+  } else {
+    print $fh "usage: $prog CMD ARGS ...\n";
+    for my $cmd (sort keys %CMD_HELP) { print $fh "\t$CMD_HELP{$cmd}\n"; }
+  }
+}
+sub bail_usage () { HELP_MESSAGE \*STDERR; exit 2; }
+
+my $DB = undef;
+my $ROOT = "/mnt/dvd/archive";
+
+sub db_connect (;$) {
+  my ($opts) = @_; $opts //= {};
+  my %opts = (AutoCommit => 0,
+	      RaiseError => 1,
+	      ReadOnly => 1,
+	      %$opts);
+  $DB = DBI->connect("dbi:Pg:host=roadstar", "", "", \%opts);
+}
+
+sub must_exist ($$@) {
+  my ($msg, $query, @args) = @_;
+  my $st = $DB->prepare($query);
+  $st->execute(@args);
+  my ($n) = $st->fetchrow_array; $st->finish;
+  $n or die $msg;
+}
+sub must_group ($) {
+  my ($group) = @_;
+  must_exist("unknown group `$group'",
+	     "SELECT COUNT(*) FROM playlist_group WHERE name = ?", $group);
+}
+sub must_list ($) {
+  my ($list) = @_;
+  must_exist("unknown list `$list'",
+	     "SELECT COUNT(*) FROM playlist WHERE name = ?", $list);
+}
+sub must_member ($$) {
+  my ($group, $list) = @_;
+  must_list $list;
+  must_exist("`$list' is not a member of `$group'",
+	     "SELECT COUNT(*) FROM playlist_position
+	      WHERE group_name = ? AND list_name = ?",
+	     $group, $list);
+}
+
+defcmd "newgroup NAME", sub {
+  @_ == 1 or bail_usage;
+  my ($name) = @_;
+  db_connect { ReadOnly => 0 };
+  $DB->do("INSERT INTO playlist_group (name) VALUES (?)", undef, $name);
+};
+
+defcmd "rmgroup NAME", sub {
+  @_ == 1 or bail_usage;
+  my ($name) = @_;
+  db_connect { ReadOnly => 0 };
+  must_group $name;
+  $DB->do("DELETE FROM playlist_group WHERE name = ?", undef, $name);
+};
+
+defcmd "groups", sub {
+  @_ == 0 or bail_usage;
+  db_connect;
+  my $st = $DB->prepare("SELECT name FROM playlist_group ORDER BY name");
+  $st->execute;
+  while (my @r = $st->fetchrow_array) { my ($name) = @r; print "$name\n"; }
+};
+
+defcmd "lists", sub {
+  @_ == 0 or bail_usage;
+  db_connect;
+  my $st = $DB->prepare("SELECT name FROM playlist ORDER BY name");
+  $st->execute;
+  while (my @r = $st->fetchrow_array) { my ($name) = @r; print "$name\n"; }
+};
+
+defcmd "edit GROUP LIST[=[+|-]POS]|-LIST ...", sub {
+  @_ >= 2 or bail_usage;
+  my ($group, @ops) = @_;
+
+  db_connect { ReadOnly => 0 };
+  must_group $group;
+  my $st_chk = $DB->prepare("SELECT n_entry FROM playlist WHERE name = ?");
+  my $st_getpos = $DB->prepare
+    ("SELECT next_entry FROM playlist_position
+      WHERE group_name = ? AND list_name = ?");
+  my $st_set = $DB->prepare
+    ("INSERT INTO playlist_position AS p (group_name, list_name, next_entry)
+      VALUES (?, ?, ?)
+      ON CONFLICT (group_name, list_name)
+	      DO UPDATE SET next_entry = ?
+	      WHERE p.group_name = ? AND p.list_name = ?");
+  my $st_del = $DB->prepare
+    ("DELETE FROM playlist_position WHERE group_name = ? AND list_name = ?");
+
+  for my $op (@ops) {
+    if ($op =~ /^ - (.++) $/x) {
+      my ($list) = ($1);
+      must_list $list; must_member $group, $list;
+      $st_del->execute($group, $list);
+    } elsif ($op =~ /^ ([^=]++) (?: = ([-+])?+ (\d++))?+ $/x) {
+      my ($list, $rel, $pos) = ($1, $2, $3);
+
+      $st_chk->execute($list);
+      my @r = $st_chk->fetchrow_array; @r or die "unknown list `$list'";
+      my ($n) = @r; $st_chk->finish;
+
+      $pos //= 0;
+      if (defined $rel) {
+	$st_getpos->execute($group, $list);
+	my @r = $st_getpos->fetchrow_array;
+	@r or die "`$list' is not a member of `$group'";
+	my ($cur) = @r; $st_getpos->finish;
+
+	if ($rel eq "+") { $pos = $cur + $pos; }
+	elsif ($rel eq "-") { $pos = $cur - $pos; }
+      }
+      0 <= $pos && $pos < $n
+	or die "`$list' position $pos out of range 0 .. $n";
+      $st_set->execute($group, $list,  $pos,
+		       $pos,  $group, $list);
+    } else {
+      die "bad edit op `$op'";
+    }
+  }
+};
+
+defcmd "next [-pu] [-o N] [-n N] GROUP [LIST]", sub {
+  local @ARGV = @_;
+  my $bogusp = 0;
+  my %opt;
+  getopts("o:n:pu", \%opt) or $bogusp = 1;
+  1 <= @ARGV && @ARGV <= 2 or $bogusp = 1;
+  !defined $opt{"o"} || $opt{"o"} =~ /^[-+]?\d+$/ or $bogusp = 1;
+  !defined $opt{"n"} || $opt{"n"} =~ /^\d+$/ or $bogusp = 1;
+  my $o = $opt{"o"} // 0;
+  my $n = $opt{"n"} // 1;
+  if ($bogusp) { bail_usage; }
+  my ($group, $list) = @ARGV;
+
+  db_connect;
+  must_group $group;
+  defined $list and  must_member $group, $list;
+
+  my $glen = 0;
+  if (!defined $list) {
+    my $st = $DB->prepare
+      ("SELECT MAX(LENGTH(list_name))
+	FROM playlist_position
+	WHERE group_name = ?");
+    $st->execute($group); ($glen) = $st->fetchrow_array; $st->finish;
+  }
+
+  my %elen; my $elen_max = -1;
+  if ($opt{"p"}) {
+    my $q =
+      "SELECT p.list_name, MAX(e.entry)
+       FROM playlist_entry AS e
+       JOIN playlist_position AS p ON e.list_name = p.list_name
+       WHERE p.group_name = ? AND
+	     p.next_entry + ? <= e.entry AND e.entry < p.next_entry + ?";
+    my @arg = ($group, $o, $n + $o);
+    if (defined $list) { $q .= " AND p.list_name = ?"; push @arg, $list; }
+    $q .= " GROUP BY p.list_name";
+    my $st = $DB->prepare($q); $st->execute(@arg);
+    while (my @r = $st->fetchrow_array) {
+      my ($l, $emax) = @r;
+      my $elen = $elen{$l} = defined $emax ? length $emax : -1;
+      $elen > $elen_max and $elen_max = $elen;
+    }
+  }
+
+  my $q =
+    "SELECT p.list_name, p.next_entry, e.entry,  c.n, s.title, m.title,
+	    m.path, m.title_number, m.start_chapter, m.end_chapter
+     FROM playlist_position AS p
+     JOIN playlist_entry AS e ON p.list_name = e.list_name
+     JOIN media AS m ON e.media_id = m.id
+     JOIN series AS s ON m.series_name = s.name
+     JOIN (SELECT t.list_name, COUNT(*) AS n
+	   FROM (SELECT DISTINCT e.list_name, m.series_name AS series_name
+		 FROM playlist_entry AS e
+		 JOIN media AS m ON e.media_id = m.id) AS t
+	   GROUP BY t.list_name) AS c
+	  ON e.list_name = c.list_name
+     WHERE p.group_name = ? AND
+	   p.next_entry + ? <= e.entry AND e.entry < p.next_entry + ?";
+  my @arg = ($group, $o, $n + $o);
+  if (defined $list) { $q .= " AND p.list_name = ?"; push @arg, $list; }
+  $q .= " ORDER BY p.list_name ASC, e.entry ASC";
+  my $st_query = $DB->prepare($q); $st_query->execute(@arg);
+  my $prevlist = undef;
+  my @out;
+
+  while (my @r = $st_query->fetchrow_array) {
+    my ($l, $pos, $i,  $nseries, $stitle, $title,
+	$path, $ttn, $loch, $hich) = @r;
+    my $out;
+    if (!$opt{"u"}) {
+      $out = $nseries == 1 ? $title : "$stitle $title";
+    } else {
+      my $scheme = $path =~ /\.iso$/ ? "dvd" : "file";
+      my $frag;
+      if ($ttn == -1) { $frag = ""; }
+      elsif ($loch == -1) { $frag = "#$ttn"; }
+      elsif ($hich == -1) { $frag = "#$ttn:$loch"; }
+      else { my $hi = $hich - 1; $frag = "#$ttn:$loch-$ttn:$hi"; }
+      $path = encode_utf8 $path;
+      $path =~ s:([^-_\w.,!\$\%/]):sprintf "%%%02x", ord $1:eg;
+      $out = "$scheme://$ROOT/$path$frag";
+    }
+    if ($opt{"p"}) {
+      my $pos = "[$i]";
+      $out = sprintf "%*s %s",
+	($n == 1 ? $elen_max : $elen{$l}) + 2, $pos, $out;
+    }
+    if ($n > 1) { $out = ($i == $pos ? "> " : "  ") . $out; }
+    if (defined $list) { print $out, "\n"; }
+    elsif ($n == 1) { printf "%-*s  %s\n", $glen, $l, $out; }
+    elsif (!defined $prevlist) { $prevlist = $l; @out = ($out); }
+    elsif (defined $prevlist && $l eq $prevlist) { push @out, $out; }
+    else {
+      print "$prevlist\n", map("\t$_\n", @out), "\n";
+      $prevlist = $l; @out = ($out);
+    }
+  }
+  defined $prevlist and print "$prevlist\n", map "\t$_\n", @out;
+};
+
+defcmd "list LIST", sub {
+  local @ARGV = @_;
+  my $bogusp = 0;
+  my %opt;
+  getopts("g:r:", \%opt) or $bogusp = 1;
+  @ARGV == 1 or $bogusp = 1;
+  if ($bogusp) { bail_usage; }
+  my ($list) = @ARGV;
+
+  db_connect;
+  must_list $list;
+  my $st_nseries = $DB->prepare
+    ("SELECT COUNT(*) FROM
+	      (SELECT DISTINCT m.series_name
+	       FROM playlist_entry AS e JOIN media AS m ON e.media_id = m.id
+	       WHERE e.list_name = ?) AS _");
+  my $st_pos = $DB->prepare
+    ("SELECT p.next_entry FROM playlist_position AS p
+      WHERE p.group_name = ? AND p.list_name = ?");
+  $st_nseries->execute($list);
+  my ($nseries) = $st_nseries->fetchrow_array; $st_nseries->finish;
+
+  my %pos; my $plen = -1;
+  if (defined $opt{"g"}) {
+    my @g = split /,/, $opt{"g"};
+    for (@g) {
+      my ($pre, $g) = /^ (?: (.*?)=)? (.*) $/x; must_group $g;
+      $st_pos->execute($g, $list); my ($pos) = $st_pos->fetchrow_array;
+      my $t = $pos{$pos} =
+	(exists $pos{$pos} ? $pos{$pos} . "," : "") .
+	($pre // (@g == 1 ? "" : $g));
+      length $t > $plen and $plen = length $t;
+    }
+  }
+
+  my $st_elen = $DB->prepare
+    ("SELECT MAX(entry) FROM playlist_entry WHERE list_name = ?");
+  $st_elen->execute($list);
+  my ($emax) = $st_elen->fetchrow_array; $st_elen->finish;
+  my $elen = length $emax;
+
+  my $q =
+    "SELECT e.entry, s.title, m.title
+     FROM playlist_entry AS e
+     JOIN media AS m ON e.media_id = m.id
+     JOIN series AS s ON m.series_name = s.name
+     WHERE e.list_name = ?";
+  my @arg = ($list);
+
+  if (defined $opt{"r"}) {
+    $opt{"r"} =~ /^ (\d+)? (?: - (\d+)?)? $/x
+      or die "invalid range expression `$opt{'r'}'";
+    my ($lo, $hi) = ($1, $2);
+    if (defined $lo) { $q .= " AND ? <= e.entry"; push @arg, $lo; }
+    if (defined $hi) { $q .= " AND e.entry < ?"; push @arg, $hi; }
+  }
+
+  $q .= " ORDER BY e.entry ASC";
+  my $st_list = $DB->prepare($q); $st_list->execute(@arg);
+  my $msep = $plen < 0 ? "" : " ";
+  while (my @r = $st_list->fetchrow_array) {
+    my ($i, $stitle, $title) = @r;
+    $nseries == 1 or $title = "$stitle $title";
+    my $m = exists $pos{$i} ? "$pos{$i}>" : "";
+    printf "%*s%s%*s %s\n", $plen + 1, $m, $msep, $elen + 2, "[$i]", $title;
+  }
+};
+
+my $bogusp = 0;
+my %opt;
+getopts("h", \%opt) or $bogusp = 1;
+if ($opt{"h"}) { HELP_MESSAGE \*STDOUT; exit 0; }
+@ARGV >= 1 or $bogusp = 1;
+if ($bogusp) { bail_usage; }
+
+$CMD = shift; $CMD_FN{$CMD} or die "unknown command `$CMD'";
+$CMD_FN{$CMD}(@ARGV);
+if (defined $DB) { $DB->commit; $DB->disconnect; }