Contents of /branches/unido/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	#!/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;