soepkiptng_delete

   1 #!/usr/bin/perl
   2 ############################################################################
   3 # soepkiptng (c) copyright 2000 Eric Lammerts <eric@lammerts.org>.
   4 ############################################################################
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License, version 2, as
   7 # published by the Free Software Foundation.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # A copy of the GNU General Public License is available on the World Wide Web
  15 # at `http://www.gnu.org/copyleft/gpl.html'.  You can also obtain it by
  16 # writing to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  17 # Boston, MA 02111-1307, USA.
  18 ############################################################################
  19
  20 use strict;
  21 use Cwd 'abs_path';
  22 use DBI;
  23 use Getopt::Std;
  24
  25 # find program directory
  26 $_ = $0;
  27 while(-l) {
  28         my $l = readlink or die "readlink $_: $!\n";
  29         if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  30 }
  31 m|(.*)/|;
  32 my $progdir = abs_path($1);
  33
  34 require "$progdir/soepkiptng.lib";
  35
  36 our ($opt_f, $opt_q, $opt_h, $opt_x, $opt_c, $opt_n);
  37 getopts('fqhxc:n');
  38
  39 my %conf;
  40 read_configfile(\%conf, $opt_c);
  41
  42 $ENV{PATH} = "$progdir/bin:$ENV{PATH}";
  43
  44 if($opt_h) {
  45         print <<EOF;
  46 Usage: soepkiptng_delete [-fqc] [dir]
  47
  48 Soepkiptng_delete deletes files from the SoepkipTNG database that do not exist
  49 anymore.
  50
  51     -f : delete entries even if they still exist
  52     -q : quiet
  53     -n : don't actually do anything to the database
  54     -x : permanently delete entries that are not present
  55
  56 EOF
  57         exit;
  58 }
  59
  60 my $dbh = DBI->connect("DBI:$conf{db_type}:$conf{db_name}:$conf{db_host}",
  61         $conf{db_user}, $conf{db_pass}) or die "can't connect to database";
  62
  63 my $sth = $dbh->prepare("SELECT filename FROM song WHERE present AND filename like ?");
  64 my $dir = "/%";
  65 if(@ARGV) {
  66         $dir = abs_path($ARGV[0]) or die "$ARGV[0]: $!\n";
  67         $dir .= "/%";
  68 } elsif($opt_f) {
  69         die "-f not allowed without dir (to avoid accidents)\n";
  70 }
  71 $dir =~ s/\\/\\\\/g;
  72 $sth->execute($dir);
  73
  74 while(my ($filename) = $sth->fetchrow_array) {
  75         if(!$opt_f) { -s $filename and next; }
  76         if($opt_n) {
  77                 my $p = "permanently " if $opt_x;
  78                 warn "Would ${p}delete $filename from database\n";
  79                 next;
  80         }
  81         warn "Deleting $filename from database.\n" unless $opt_q;
  82         if($opt_x) {
  83                 $dbh->do("DELETE FROM song WHERE filename=?", undef, $filename);
  84         } else {
  85                 $dbh->do("UPDATE song SET present=0 WHERE filename=?", undef, $filename);
  86         }
  87 }
  88
  89 $dbh->disconnect();