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 | 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; |