soepkiptng_mv

   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 my $progdir;
  21 BEGIN {
  22         use Cwd qw'abs_path cwd';
  23
  24         # find program directory
  25         $_ = $0;
  26         while(-l) {
  27                 my $l = readlink or die "readlink $_: $!\n";
  28                 if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  29         }
  30         m|(.*)/|;
  31         $progdir = abs_path($1);
  32
  33         unshift @INC, "$progdir/lib";
  34 }
  35 require "$progdir/soepkiptng.lib";
  36 $ENV{PATH} = "$progdir/bin:$ENV{PATH}";
  37
  38 use strict;
  39 use DBI;
  40 use Getopt::Std;
  41 use Data::Dumper;
  42
  43 our ($opt_c, $opt_h, $opt_n);
  44 getopts('c:hn');
  45 $| = 1;
  46
  47 if($opt_h || @ARGV < 2) { die <<EOF; }
  48 usage: soepkiptng_mv [-n] [-c configfile] <fromdir> <todir>
  49
  50 With this command you can rename a directory, and all entries in the
  51 database will have their paths renamed accordingly.
  52
  53 options:
  54   -c configfile : override soepkiptng config file
  55   -n            : test mode, don't change anything
  56 EOF
  57
  58 my %conf;
  59 read_configfile(\%conf, $opt_c);
  60
  61 my $dbh = connect_to_db(\%conf);
  62
  63 my ($from, $to) = @ARGV;
  64
  65 if(-e $to) {
  66         die "$to exists, quitting\n";
  67 }
  68
  69 my $absfrom = abs_path($from);
  70 my $absto = abs_path($to);
  71
  72 if($opt_n) {
  73         warn "would rename $absfrom to\n             $absto\n";
  74 } else {
  75         rename $from, $to
  76                 or die "rename $from -> $to: $!\n";
  77 }
  78
  79 my $f = $dbh->selectall_hashref("SELECT id,filename FROM song WHERE filename LIKE ? AND present",
  80         "id", undef, "$absfrom/%");
  81 foreach my $id (sort { $f->{$a}->{filename} cmp $f->{$a}->{filename} } keys %{$f}) {
  82         my $name = $f->{$id}->{filename};
  83         if(substr($name, 0, length("$absfrom/")) ne "$absfrom/") {
  84                 die "filename\n$name does not match\n$absfrom/% ???\n";
  85         }
  86         substr($name, 0, length("$absfrom")) = $absto;
  87         if($opt_n) {
  88                 warn "db: $f->{$id}->{filename}\n -> $name\n";
  89         } else {
  90                 $dbh->do("UPDATE song SET filename=? WHERE id=?", undef, $name, $id)
  91                         or die "can't do sql command: " . $dbh->errstr . "\n";
  92         }
  93 }