--- /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:^.*/::;
+sub HELP_MESSAGE ($;@) {
+ my ($fh) = @_;
+ print $fh "usage: $prog [-f]\n";
+}
+
+my $bogusp = 0;
+my %opt;
+getopts("hf", \%opt) or $bogusp = 1;
+if ($opt{"h"}) { HELP_MESSAGE \*STDOUT; exit 0; }
+@ARGV == 0 or $bogusp = 1;
+if ($bogusp) { HELP_MESSAGE \*STDERR; exit 2; }
+
+my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "",
+ { AutoCommit => 0,
+ RaiseError => 1 });
+
+for my $item (["media", "id", "title",
+ "playlist_entry", "media_id", "list_name"],
+ ["series", "name", "name",
+ "media", "series_name", "id"],
+ ["playlist", "name", "name",
+ "playlist_entry", "list_name", "entry"],
+ ["dvd_set", "id", "name",
+ "dvd_disc", "set_id", "disc"]) {
+ my ($table, $key, $name, $reftable, $refcol, $testcol) = @$item;
+ my $st = $DB->prepare
+ ("SELECT t.$name FROM $table AS t
+ LEFT JOIN $reftable AS r ON r.$refcol = t.$key
+ WHERE r.$testcol IS NULL");
+ $st->execute;
+ my $any = 0;
+ while (my @r = $st->fetchrow_array)
+ { my ($rowname) = @r; print "$table: $rowname\n"; $any = 1; }
+
+ if ($any && $opt{"f"}) {
+ my $n = $DB->do
+ ("DELETE FROM $table WHERE $key IN
+ (SELECT t.$key FROM $table AS t
+ LEFT JOIN $reftable AS r ON r.$refcol = t.$key
+ WHERE r.$testcol IS NULL)");
+ print "$table: deleted $n\n";
+ }
+}
+
+$DB->commit; $DB->disconnect;