[dvddb] / pldb

#! /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;dbname=mdw", "", "", \%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; }
Commit	Line	Data
b2a25885 MW	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);
a2dfdd89	47	$DB = DBI->connect("dbi:Pg:host=roadstar;dbname=mdw", "", "", \%opts);
b2a25885 MW	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
86ca2191	107	defcmd "edit GROUP LIST[[+\|-]=POS]\|-LIST ...", sub {
b2a25885 MW	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);
86ca2191 MW	131	} elsif ($op =~ /^ ((?: [^-+=]++ \| [-+][^=])++)
86ca2191 MW	132	(?: ([-+])?+ = ([-+]?+ \d++))?+ $/x) {
b2a25885 MW	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; }