chiark - git - mdw - dvddb/blob - 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;