source: branches/properties/lib/macros/keep_listed_trees.amc

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

# ------------------------------ configure trees to keep

# simply enter names of trees to remain in the list below.
my @keep =
  (
   'tree_to_keep',
  );



# ------------------------------ configure trees 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 trees from your database.\nTo use, edit it, uncomment this line and save it locally.\nAlso edit list of kept trees to fit your needs.";

# ------------------------------ read existing trees

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

my $gb_trees = ARB::search($gb_main, '/tree_data', 'NONE');
die 'failed to find tree-data' if not $gb_trees;

my @trees = ();

for (my $gb_sub = ARB::child($gb_trees); $gb_sub; $gb_sub = ARB::nextChild($gb_sub)) { # read all childs
  my $name = ARB::read_key($gb_sub); # the tree name is "stored" in the key name :-(
  expectError('read name of tree') if not $name;
  if (substr($name, 0, 5) eq 'tree_') {
    push @trees, $name;
  }
  else {
    print "Skipping entry '$name' (not a tree)\n";
  }
}

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

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

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

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

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

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

BIO::remote_action($gb_main,'ARB_NT','tree_admin');

my $count = 0;
foreach my $treedel (@delete) {
  ++$count;
  my $percent = int($count/$delete*100.0);
  print "Deleting tree $count/$delete ($percent%, '$treedel')\n";
  BIO::remote_awar($gb_main,'ARB_NT','tmp/ad_tree/tree_name', $treedel);
  BIO::remote_action($gb_main,'ARB_NT','TREE_ADMIN/DELETE');
}

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

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