source: branches/sina/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";

  ARB::close($gb_main);
}

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();