pldb (list): Add `-w' option to show a window around the group position(s).
[dvddb] / cleanup
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;