soepkiptng_update6.pl

   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 integer;
  21 use Cwd 'abs_path';
  22 use DBI;
  23 use Socket;
  24 use Getopt::Std;
  25
  26 # find program directory
  27 $_ = $0;
  28 while(-l) {
  29         my $l = readlink or die "readlink $_: $!\n";
  30         if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  31 }
  32 m|(.*)/|;
  33 my $progdir = abs_path($1);
  34
  35 require "$progdir/soepkiptng.lib";
  36
  37 getopts('avnc:gt:');
  38
  39 read_configfile(\%conf, $opt_c);
  40
  41
  42 sub uuid_gen() {
  43         local *F;
  44         my $buf;
  45
  46         open F, "/dev/urandom" or die "/dev/urandom: $!\n";
  47         read F, $buf, 16;
  48         close F;
  49
  50         my @w = unpack("n*", $buf);
  51         $w[3] &= 0x0fff; $w[3] |= 0x4000;
  52         $w[4] &= 0x3fff; $w[4] |= 0x8000;
  53
  54         $buf = pack("n8", @w);
  55         return $buf;
  56 }
  57
  58 sub uuid_ascii($)
  59 {
  60         my @w = unpack("n*", $_[0]);
  61         return sprintf "%04x%04x-%04x-%04x-%04x-%04x%04x%04x", @w;
  62 }
  63
  64
  65 $| = 1;
  66
  67 $dbh = connect_to_db(\%conf);
  68
  69 $ids = $dbh->selectcol_arrayref("SELECT id FROM song WHERE present AND filename LIKE '/%' AND uuid IS NULL");
  70
  71 foreach(@$ids) {
  72         $uuid = uuid_ascii(uuid_gen);
  73         $dbh->do("UPDATE song SET uuid=? WHERE id=?", undef, $uuid, $_);
  74         printf "%s %s\n", $uuid, $_;
  75 }