#!/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);