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