X-Git-Url: https://git.distorted.org.uk/~mdw/dvddb/blobdiff_plain/9a00b56dd36ffa919ab9e7b48bb919d380b396c9..refs/heads/master:/pldb

diff --git a/pldb b/pldb
index b988145..40c67e0 100755
--- a/pldb
+++ b/pldb
@@ -260,11 +260,11 @@ defcmd "next [-pu] [-o N] [-n N] GROUP [LIST]", sub {
   defined $prevlist and print "$prevlist\n", map "\t$_\n", @out;
 };
 
-defcmd "list LIST", sub {
+defcmd "list [-g [MARK=]GROUP,...] [-r [LO][-[HI]],...] [-w WIN] LIST", sub {
   local @ARGV = @_;
   my $bogusp = 0;
   my %opt;
-  getopts("g:r:", \%opt) or $bogusp = 1;
+  getopts("g:r:w:", \%opt) or $bogusp = 1;
   @ARGV == 1 or $bogusp = 1;
   if ($bogusp) { bail_usage; }
   my ($list) = @ARGV;
@@ -285,9 +285,10 @@ defcmd "list LIST", sub {
   my %pos; my $plen = -1;
   if (defined $opt{"g"}) {
     my @g = split /,/, $opt{"g"};
-    for (@g) {
+    GROUP: for (@g) {
       my ($pre, $g) = /^ (?: (.*?)=)? (.*) $/x; must_group $g;
       $st_pos->execute($g, $list); my ($pos) = $st_pos->fetchrow_array;
+      next GROUP unless defined $pos;
       my $t = $pos{$pos} =
 	(exists $pos{$pos} ? $pos{$pos} . "," : "") .
 	($pre // (@g == 1 ? "" : $g));
@@ -309,12 +310,48 @@ defcmd "list LIST", sub {
      WHERE e.list_name = ?";
   my @arg = ($list);
 
+  my @r;
   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; }
+    for my $r (split /,/, $opt{"r"}) {
+      $r =~ /^ (\d+)? (?: - (\d+)?)? $/x
+	or die "invalid range expression `$r'";
+      my ($lo, $hi) = ($1 // 0, $2 // $emax + 1);
+      $hi <= $emax or $hi = $emax + 1;
+      push @r, [$lo, $hi];
+    }
+  }
+
+  if (defined $opt{"w"}) {
+    (my $w = $opt{"w"}) =~ /^\d+$/ or die "bad window size `$opt{w}'";
+    %pos or die "no positions";
+    for my $pos (keys %pos) { push @r, [$pos - $w, $pos + $w + 1] }
+  }
+
+  if (@r) {
+    my ($curr_lo, $curr_hi) = (undef, undef);
+    my @newr;
+    RANGE: for my $r (sort { $a->[0] <=> $b->[0] ||
+			     $a->[1] <=> $b->[1] } @r) {
+      my ($lo, $hi) = @$r;
+      if (defined $curr_hi) {
+	if ($lo <= $curr_hi) { $curr_hi = $hi; next RANGE; }
+	push @newr, [$curr_lo, $curr_hi];
+      }
+      ($curr_lo, $curr_hi) = ($lo, $hi);
+    }
+    push @newr, [$curr_lo, $curr_hi];
+    my @q;
+    for my $r (@newr) {
+      my ($lo, $hi) = @$r;
+      my @qr;
+      if ($lo > 0) { push @qr, "? <= e.entry"; push @arg, $lo; }
+      if ($hi <= $emax ) { push @qr, "e.entry < ?"; push @arg, $hi; }
+      if (!@qr) { }
+      elsif (@qr == 1) { push @q, @qr; }
+      else { push @q, "(" . join(" AND ", @qr) . ")"; }
+    }
+    if (@q == 1) { $q .= " AND $q[0]"; }
+    else { $q .= " AND (" . join(" OR ", @q) . ")"; }
   }
 
   $q .= " ORDER BY e.entry ASC";