source: trunk/lib/macros/keep_listed_speciesSelections.amc

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

# ------------------------------ configure speciesSelections to keep

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



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

# ------------------------------ read existing speciesSelections

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

my $gb_configs = ARB::search($gb_main, '/configuration_data', 'NONE');
die 'failed to find speciesSelection-data' if not $gb_configs;

my @speciesSelections = ();

for (my $gb_sel = ARB::entry($gb_configs, 'configuration'); $gb_sel; $gb_sel = ARB::nextEntry($gb_sel)) {
  my $gb_name = ARB::entry($gb_sel, 'name');
  die 'speciesSelection lacks name' if not $gb_name;
  my $name = ARB::read_string($gb_name);
  expectError('read name of speciesSelection') if not $name;
  push @speciesSelections, $name;
}

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

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

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

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

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

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

BIO::remote_action($gb_main,'ARB_NT','ARB_NT/selection_admin2');

my $count = 0;
foreach my $seldel (@delete) {
  ++$count;
  my $percent = int($count/$delete*100.0);
  print "Deleting speciesSelection $count/$delete ($percent%, '$seldel')\n";
  BIO::remote_awar($gb_main,'ARB_NT','focus/configuration', $seldel);
  BIO::remote_action($gb_main,'ARB_NT','SPECIES_SELECTIONS_0/DELETE');
}

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

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