| 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 | sub HELP_MESSAGE ($;@) { |
| 19 | my ($fh) = @_; |
| 20 | print $fh "usage: $prog [-f]\n"; |
| 21 | } |
| 22 | |
| 23 | my $bogusp = 0; |
| 24 | my %opt; |
| 25 | getopts("hf", \%opt) or $bogusp = 1; |
| 26 | if ($opt{"h"}) { HELP_MESSAGE \*STDOUT; exit 0; } |
| 27 | @ARGV == 0 or $bogusp = 1; |
| 28 | if ($bogusp) { HELP_MESSAGE \*STDERR; exit 2; } |
| 29 | |
| 30 | my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "", |
| 31 | { AutoCommit => 0, |
| 32 | RaiseError => 1 }); |
| 33 | |
| 34 | for my $item (["media", "id", "title", |
| 35 | "playlist_entry", "media_id", "list_name"], |
| 36 | ["series", "name", "name", |
| 37 | "media", "series_name", "id"], |
| 38 | ["playlist", "name", "name", |
| 39 | "playlist_entry", "list_name", "entry"], |
| 40 | ["dvd_set", "id", "name", |
| 41 | "dvd_disc", "set_id", "disc"]) { |
| 42 | my ($table, $key, $name, $reftable, $refcol, $testcol) = @$item; |
| 43 | my $st = $DB->prepare |
| 44 | ("SELECT t.$name FROM $table AS t |
| 45 | LEFT JOIN $reftable AS r ON r.$refcol = t.$key |
| 46 | WHERE r.$testcol IS NULL"); |
| 47 | $st->execute; |
| 48 | my $any = 0; |
| 49 | while (my @r = $st->fetchrow_array) |
| 50 | { my ($rowname) = @r; print "$table: $rowname\n"; $any = 1; } |
| 51 | |
| 52 | if ($any && $opt{"f"}) { |
| 53 | my $n = $DB->do |
| 54 | ("DELETE FROM $table WHERE $key IN |
| 55 | (SELECT t.$key FROM $table AS t |
| 56 | LEFT JOIN $reftable AS r ON r.$refcol = t.$key |
| 57 | WHERE r.$testcol IS NULL)"); |
| 58 | print "$table: deleted $n\n"; |
| 59 | } |
| 60 | } |
| 61 | |
| 62 | $DB->commit; $DB->disconnect; |