source: trunk/lib/macros/keep_listed_fields.amc

#!/usr/bin/perl
use strict;
use warnings;

# ------------------------------ configure keys to keep

# simply enter names of keys to remain in the list below.
# Note: containers will be deleted as well (but never if name starts with 'ali_')
my @keep =
  (
   'name',
   'acc',
   'full_name',
   'journal',
   'author',
   'title',
  );



# ------------------------------ configure keys to keep [end]

BEGIN {
  if (not exists $ENV{'ARBHOME'}) { die "Environment variable \$ARBHOME has to be defined"; }
  my $arbhome = $ENV{'ARBHOME'};
  push @INC, "$arbhome/lib";
  push @INC, "$arbhome/PERL_SCRIPTS/lib";
  1;
}

use ARB;
use tools;

my $gb_main = ARB::open(":","r");
if (not $gb_main) {
  my $error = ARB::await_error();
  die "$error";
}

die "This script will delete most database fields.\nTo use, edit it, uncomment this line and save it locally.\nAlso edit list of kept fields to fit your needs.";

# ------------------------------ refresh list of existing keys

# recording started @ Sun Dec 26 11:19:16 2021
BIO::remote_action($gb_main,'ARB_NT','ARB_NT/INFO');

BIO::message($gb_main, "Refreshing list of existing keys..");
BIO::remote_action($gb_main,'ARB_NT','spec_refresh_fields');

# ------------------------------ read existing keys

dieOnError(ARB::begin_transaction($gb_main), 'begin_transaction');

my $gb_keys = ARB::search($gb_main, '/presets/key_data', 'NONE');
die 'failed to find key-data' if not $gb_keys;

my @keys = ();

for (my $gb_key = ARB::entry($gb_keys, 'key'); $gb_key; $gb_key = ARB::nextEntry($gb_key)) {
  my $gb_name = ARB::entry($gb_key, 'key_name');
  die 'key lacks key_name' if not $gb_name;
  my $name = ARB::read_string($gb_name);
  expectError('read name of key') if not $name;

  my $whyNotDelete = undef;
  if ($name =~ /\/.*$/o) {
    $whyNotDelete = "keep subentry '$name' (handled with container '$`')";
  }
  if ($name =~ /^ali_/o) {
    my $gb_type = ARB::entry($gb_key, 'key_type');
    die "key '$name' lacks key_type" if not $gb_type;
    my $type = ARB::read_int($gb_type);
    $whyNotDelete = "keep alignment '$name'" if $type==15; # type 15 is container;
  }

  if (defined $whyNotDelete) {
    BIO::message($gb_main, $whyNotDelete);
  }
  else {
    push @keys, $name;
  }
}

dieOnError(ARB::commit_transaction($gb_main), 'commit_transaction');

my $keys = scalar(@keys);
BIO::message($gb_main, "Found $keys keys");

# ------------------------------ read existing keys [end]
# ------------------------------ decide which keys to delete

my %keep = map { $_ => 1; } @keep;
my @delete = grep { not defined $keep{$_}; } @keys;

my $keep = scalar(@keep);
my $delete = scalar(@delete);
BIO::message($gb_main, "Deleting $delete keys ($keep listed as protected)");

# ------------------------------ decide which keys to delete [end]

BIO::remote_action($gb_main,'ARB_NT','SPECIES_INFORMATION/spec_delete_field');
BIO::remote_action($gb_main,'ARB_NT','spec_refresh_fields');

my $count = 0;
foreach my $keydel (@delete) {
  ++$count;
  my $percent = int($count/$delete*100.0);
  print "Deleting field $count/$delete ($percent%, '$keydel')\n";
  BIO::remote_awar($gb_main,'ARB_NT','tmp/adfield/species/source', $keydel);
  BIO::remote_action($gb_main,'ARB_NT','DELETE_FIELD/DELETE_FIELD');
}

BIO::message($gb_main, "$delete unlisted keys have been deleted.");
BIO::message($gb_main, "Check remaining keys before you overwrite your database.");

# recording stopped @ Sun Dec 26 11:19:28 2021
ARB::close($gb_main);