source: branches/help/PERL_SCRIPTS/ARBTOOLS/TESTS/automatic.pl

#! /usr/bin/perl

use strict;
use warnings;

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;

sub run_test($$) {
    my ($client, $dbname) = @_;
    my $gb_main = ARB::open($dbname, "r");
    if (!$gb_main) {
        die "Could not open ARB database. '$dbname'"
    }

    my $species_count = 0;
    for (my $gb_species = BIO::first_species($gb_main);
       $gb_species;
       $gb_species = BIO::next_species($gb_species)) {
           $species_count++;
    }

    print "Number of species in database: $species_count\n";
}

sub die_usage($) {
  my ($err) = @_;
  print "Purpose: test if the perl interface of ARB is working\n";
  print "Usage: automatic.pl [-db <DBNAME>] -client <CLIENT_NAME>\n";
  print "       -db        optional ARB database name to open,\n";
  print "                  if omitted runnig ARB instance is used.\n";
  print "                  Script must be from within ARB to access\n";
  print "                  the running instance.\n";
  print "       -client    test client. Must be either arb or homebrew.\n";
  print "\n";
  die "Error: $err\n";
}

sub main() {
  my $args = scalar(@ARGV);
  if ($args<2) { die_usage('Missing arguments'); }

  my $dbname;
  my $client;

  while ($ARGV[0] && substr($ARGV[0],0,1) eq '-') {
    my $arg = shift @ARGV;
    if ($arg eq '-db') { $dbname = shift @ARGV; }
    elsif ($arg eq '-client') { $client = shift @ARGV; }
    else { die_usage("Unknown switch '$arg'"); }
  }

  if (not defined $client) {
      die_usage('Client must be given.');
  } elsif ($client ne 'arb' && $client ne 'homebrew') {
      die_usage("Client must be either arb or homebrew but is '$client'");
  }

  # use running ARB if no database name is given
  if (not defined $dbname) {
      $dbname = ':';
  }

  run_test($client, $dbname);
}

main();