--- /dev/null
+#! /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; }
~mdw / dvddb / blobdiff