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   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         if ($rel eq "+") { $pos = $cur + $pos; }
 147         elsif ($rel eq "-") { $pos = $cur - $pos; }
 148       }
 149       0 <= $pos && $pos < $n
 150         or die "`$list' position $pos out of range 0 .. $n";
 151       $st_set->execute($group, $list,  $pos,
 152                        $pos,  $group, $list);
 153     } else {
 154       die "bad edit op `$op'";
 155     }
 156   }
 157 };
 158
 159 defcmd "next [-pu] [-o N] [-n N] GROUP [LIST]", sub {
 160   local @ARGV = @_;
 161   my $bogusp = 0;
 162   my %opt;
 163   getopts("o:n:pu", \%opt) or $bogusp = 1;
 164   1 <= @ARGV && @ARGV <= 2 or $bogusp = 1;
 165   !defined $opt{"o"} || $opt{"o"} =~ /^[-+]?\d+$/ or $bogusp = 1;
 166   !defined $opt{"n"} || $opt{"n"} =~ /^\d+$/ or $bogusp = 1;
 167   my $o = $opt{"o"} // 0;
 168   my $n = $opt{"n"} // 1;
 169   if ($bogusp) { bail_usage; }
 170   my ($group, $list) = @ARGV;
 171
 172   db_connect;
 173   must_group $group;
 174   defined $list and  must_member $group, $list;
 175
 176   my $glen = 0;
 177   if (!defined $list) {
 178     my $st = $DB->prepare
 179       ("SELECT MAX(LENGTH(list_name))
 180         FROM playlist_position
 181         WHERE group_name = ?");
 182     $st->execute($group); ($glen) = $st->fetchrow_array; $st->finish;
 183   }
 184
 185   my %elen; my $elen_max = -1;
 186   if ($opt{"p"}) {
 187     my $q =
 188       "SELECT p.list_name, MAX(e.entry)
 189        FROM playlist_entry AS e
 190        JOIN playlist_position AS p ON e.list_name = p.list_name
 191        WHERE p.group_name = ? AND
 192              p.next_entry + ? <= e.entry AND e.entry < p.next_entry + ?";
 193     my @arg = ($group, $o, $n + $o);
 194     if (defined $list) { $q .= " AND p.list_name = ?"; push @arg, $list; }
 195     $q .= " GROUP BY p.list_name";
 196     my $st = $DB->prepare($q); $st->execute(@arg);
 197     while (my @r = $st->fetchrow_array) {
 198       my ($l, $emax) = @r;
 199       my $elen = $elen{$l} = defined $emax ? length $emax : -1;
 200       $elen > $elen_max and $elen_max = $elen;
 201     }
 202   }
 203
 204   my $q =
 205     "SELECT p.list_name, p.next_entry, e.entry,  c.n, s.title, m.title,
 206             m.path, m.title_number, m.start_chapter, m.end_chapter
 207      FROM playlist_position AS p
 208      JOIN playlist_entry AS e ON p.list_name = e.list_name
 209      JOIN media AS m ON e.media_id = m.id
 210      JOIN series AS s ON m.series_name = s.name
 211      JOIN (SELECT t.list_name, COUNT(*) AS n
 212            FROM (SELECT DISTINCT e.list_name, m.series_name AS series_name
 213                  FROM playlist_entry AS e
 214                  JOIN media AS m ON e.media_id = m.id) AS t
 215            GROUP BY t.list_name) AS c
 216           ON e.list_name = c.list_name
 217      WHERE p.group_name = ? AND
 218            p.next_entry + ? <= e.entry AND e.entry < p.next_entry + ?";
 219   my @arg = ($group, $o, $n + $o);
 220   if (defined $list) { $q .= " AND p.list_name = ?"; push @arg, $list; }
 221   $q .= " ORDER BY p.list_name ASC, e.entry ASC";
 222   my $st_query = $DB->prepare($q); $st_query->execute(@arg);
 223   my $prevlist = undef;
 224   my @out;
 225
 226   while (my @r = $st_query->fetchrow_array) {
 227     my ($l, $pos, $i,  $nseries, $stitle, $title,
 228         $path, $ttn, $loch, $hich) = @r;
 229     my $out;
 230     if (!$opt{"u"}) {
 231       $out = $nseries == 1 ? $title : "$stitle $title";
 232     } else {
 233       my $scheme = $path =~ /\.iso$/ ? "dvd" : "file";
 234       my $frag;
 235       if ($ttn == -1) { $frag = ""; }
 236       elsif ($loch == -1) { $frag = "#$ttn"; }
 237       elsif ($hich == -1) { $frag = "#$ttn:$loch"; }
 238       else { my $hi = $hich - 1; $frag = "#$ttn:$loch-$ttn:$hi"; }
 239       $path = encode_utf8 $path;
 240       $path =~ s:([^-_\w.,!\$\%/]):sprintf "%%%02x", ord $1:eg;
 241       $out = "$scheme://$ROOT/$path$frag";
 242     }
 243     if ($opt{"p"}) {
 244       my $pos = "[$i]";
 245       $out = sprintf "%*s %s",
 246         ($n == 1 ? $elen_max : $elen{$l}) + 2, $pos, $out;
 247     }
 248     if ($n > 1) { $out = ($i == $pos ? "> " : "  ") . $out; }
 249     if (defined $list) { print $out, "\n"; }
 250     elsif ($n == 1) { printf "%-*s  %s\n", $glen, $l, $out; }
 251     elsif (!defined $prevlist) { $prevlist = $l; @out = ($out); }
 252     elsif (defined $prevlist && $l eq $prevlist) { push @out, $out; }
 253     else {
 254       print "$prevlist\n", map("\t$_\n", @out), "\n";
 255       $prevlist = $l; @out = ($out);
 256     }
 257   }
 258   defined $prevlist and print "$prevlist\n", map "\t$_\n", @out;
 259 };
 260
 261 defcmd "list LIST", sub {
 262   local @ARGV = @_;
 263   my $bogusp = 0;
 264   my %opt;
 265   getopts("g:r:", \%opt) or $bogusp = 1;
 266   @ARGV == 1 or $bogusp = 1;
 267   if ($bogusp) { bail_usage; }
 268   my ($list) = @ARGV;
 269
 270   db_connect;
 271   must_list $list;
 272   my $st_nseries = $DB->prepare
 273     ("SELECT COUNT(*) FROM
 274               (SELECT DISTINCT m.series_name
 275                FROM playlist_entry AS e JOIN media AS m ON e.media_id = m.id
 276                WHERE e.list_name = ?) AS _");
 277   my $st_pos = $DB->prepare
 278     ("SELECT p.next_entry FROM playlist_position AS p
 279       WHERE p.group_name = ? AND p.list_name = ?");
 280   $st_nseries->execute($list);
 281   my ($nseries) = $st_nseries->fetchrow_array; $st_nseries->finish;
 282
 283   my %pos; my $plen = -1;
 284   if (defined $opt{"g"}) {
 285     my @g = split /,/, $opt{"g"};
 286     for (@g) {
 287       my ($pre, $g) = /^ (?: (.*?)=)? (.*) $/x; must_group $g;
 288       $st_pos->execute($g, $list); my ($pos) = $st_pos->fetchrow_array;
 289       my $t = $pos{$pos} =
 290         (exists $pos{$pos} ? $pos{$pos} . "," : "") .
 291         ($pre // (@g == 1 ? "" : $g));
 292       length $t > $plen and $plen = length $t;
 293     }
 294   }
 295
 296   my $st_elen = $DB->prepare
 297     ("SELECT MAX(entry) FROM playlist_entry WHERE list_name = ?");
 298   $st_elen->execute($list);
 299   my ($emax) = $st_elen->fetchrow_array; $st_elen->finish;
 300   my $elen = length $emax;
 301
 302   my $q =
 303     "SELECT e.entry, s.title, m.title
 304      FROM playlist_entry AS e
 305      JOIN media AS m ON e.media_id = m.id
 306      JOIN series AS s ON m.series_name = s.name
 307      WHERE e.list_name = ?";
 308   my @arg = ($list);
 309
 310   if (defined $opt{"r"}) {
 311     $opt{"r"} =~ /^ (\d+)? (?: - (\d+)?)? $/x
 312       or die "invalid range expression `$opt{'r'}'";
 313     my ($lo, $hi) = ($1, $2);
 314     if (defined $lo) { $q .= " AND ? <= e.entry"; push @arg, $lo; }
 315     if (defined $hi) { $q .= " AND e.entry < ?"; push @arg, $hi; }
 316   }
 317
 318   $q .= " ORDER BY e.entry ASC";
 319   my $st_list = $DB->prepare($q); $st_list->execute(@arg);
 320   my $msep = $plen < 0 ? "" : " ";
 321   while (my @r = $st_list->fetchrow_array) {
 322     my ($i, $stitle, $title) = @r;
 323     $nseries == 1 or $title = "$stitle $title";
 324     my $m = exists $pos{$i} ? "$pos{$i}>" : "";
 325     printf "%*s%s%*s %s\n", $plen + 1, $m, $msep, $elen + 2, "[$i]", $title;
 326   }
 327 };
 328
 329 my $bogusp = 0;
 330 my %opt;
 331 getopts("h", \%opt) or $bogusp = 1;
 332 if ($opt{"h"}) { HELP_MESSAGE \*STDOUT; exit 0; }
 333 @ARGV >= 1 or $bogusp = 1;
 334 if ($bogusp) { bail_usage; }
 335
 336 $CMD = shift; $CMD_FN{$CMD} or die "unknown command `$CMD'";
 337 $CMD_FN{$CMD}(@ARGV);
 338 if (defined $DB) { $DB->commit; $DB->disconnect; }