Annotation of /trunk/script/upgrade_index

#!/usr/local/bin/perl -w
#                              -*- Mode: Perl -*- 
# $Basename$
# $Revision: 1.1 $
# Author          : Ulrich Pfeifer
# Created On      : Mon Apr 17 12:33:23 2000
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Sat Nov 11 17:03:14 2000
# Language        : CPerl
# 
# (C) Copyright 2000, UUNET Deutschland GmbH, Germany
# 

use DB_File;
use strict;
use Getopt::Long;
use Fcntl;

my $old;

if (!GetOptions ('force' => \$old) or (@ARGV != 2)) {
  die "USAGE: [-f] <infile> <outfile>\n";
}

my %idx;
my %out;
my ($infile, $outfile) = @ARGV;

my $dbh = tie %idx, 'DB_File', $infile,  O_RDONLY, 0664, $DB_BTREE
  or die "Could not open '$infile': $!";
my $out = tie %out, 'DB_File', $outfile, O_RDWR|O_CREAT, 0664, $DB_BTREE
  or die "Could not open '$outfile': $!";

sub is_an_old_index {
  my $dbh = shift;

  my $O = pack('C', 0xff)."o";
  my ($word, $value) = ($O.$;);
  $dbh->seq($word, $value, R_CURSOR);
  for (my $i=0; $i<10;$i++) {
    if (not $value or $value !~ /^\d+$/) {
      return 0;
    }
    if ($dbh->seq($word, $value, R_NEXT) or # no values left
        $word !~ /^$O/o                     # no $O values left
       ) {
      # we are not sure enough that this is an old index
      print "Hmm, that's difficult\n";
      return 0;
    }
  }
  return 1;
}

$old ||= is_an_old_index($dbh);

unless ($old) {
  die "$infile probably not an old index.  Call me with '-f' if you are sure";
}

while (my($key, $value) = each %idx) {
  if ($key =~ /^\377([om])$;(.*)/) {
    $out{$1.$2} = $value;
  } else {
    $out{'p'.$key} = $value;
  }
}

undef $dbh;
untie %idx;
undef $out;
untie %out;
1	ulpfr	22	#!/usr/local/bin/perl -w
2			# -- Mode: Perl --
3			# $Basename$
4			# $Revision: 1.1 $
5			# Author : Ulrich Pfeifer
6			# Created On : Mon Apr 17 12:33:23 2000
7			# Last Modified By: Ulrich Pfeifer
8			# Last Modified On: Sat Nov 11 17:03:14 2000
9			# Language : CPerl
10			#
11			# (C) Copyright 2000, UUNET Deutschland GmbH, Germany
12			#
13
14			use DB_File;
15			use strict;
16			use Getopt::Long;
17			use Fcntl;
18
19			my $old;
20
21			if (!GetOptions ('force' => \$old) or (@ARGV != 2)) {
22			die "USAGE: [-f] <infile> <outfile>\n";
23			}
24
25			my %idx;
26			my %out;
27			my ($infile, $outfile) = @ARGV;
28
29			my $dbh = tie %idx, 'DB_File', $infile, O_RDONLY, 0664, $DB_BTREE
30			or die "Could not open '$infile': $!";
31			my $out = tie %out, 'DB_File', $outfile, O_RDWR\|O_CREAT, 0664, $DB_BTREE
32			or die "Could not open '$outfile': $!";
33
34			sub is_an_old_index {
35			my $dbh = shift;
36
37			my $O = pack('C', 0xff)."o";
38			my ($word, $value) = ($O.$;);
39			$dbh->seq($word, $value, R_CURSOR);
40			for (my $i=0; $i<10;$i++) {
41			if (not $value or $value !~ /^\d+$/) {
42			return 0;
43			}
44			if ($dbh->seq($word, $value, R_NEXT) or # no values left
45			$word !~ /^$O/o # no $O values left
46			) {
47			# we are not sure enough that this is an old index
48			print "Hmm, that's difficult\n";
49			return 0;
50			}
51			}
52			return 1;
53			}
54
55			$old \|\|= is_an_old_index($dbh);
56
57			unless ($old) {
58			die "$infile probably not an old index. Call me with '-f' if you are sure";
59			}
60
61			while (my($key, $value) = each %idx) {
62			if ($key =~ /^\377([om])$;(.*)/) {
63			$out{$1.$2} = $value;
64			} else {
65			$out{'p'.$key} = $value;
66			}
67			}
68
69			undef $dbh;
70			untie %idx;
71			undef $out;
72			untie %out;