my $string = shift;
  my $delim = shift;
  
  $$string =~ s/^(\s)+//;

  return undef unless(length($$string));
  
  #print("input =>$$string\n");
  #print("delim =>$delim\n");
  my $index=undef;

  my @delims = split(/ */, $delim);
  foreach my $dl (@delims) {
    my $pos = index($$string, $dl);
    if($pos>=0) {
      $index = $pos unless(defined($index));
      $index = $pos if($pos<$index);
    }
  }
  unless(defined($index)) {
    throw("couldn't find delimiter $delim\n");
  }

  my $token ='';

  if($index==0) {
    $token = substr($$string,0,1);
    $$string = substr($$string, 1);
  } else {
    $token = substr($$string, 0, $index);
    $$string = substr($$string, $index);
  }

  #print("  token     =>$token\n");
  #print("  outstring =>$$string\n\n");
  
  return $token;
}


1;

  my $newick = shift;

  my $count=1;
  my $debug = 0;
  print("$newick\n") if($debug);
  my $token = next_token(\$newick, "(;");
  my $lastset = undef;
  my $node = undef;
  my $root = undef;
  my $state=1;
  my $bracket_level = 0;

  while(defined($token)) {
    if($debug) { printf("state %d : '%s'\n", $state, $token); };
    
    switch ($state) {
      case 1 { #new node
        $node = new Bio::EnsEMBL::Compara::NestedSet;
        $node->node_id($count++);
        $lastset->add_child($node) if($lastset);
        $root=$node unless($root);
        if($token eq '(') { #create new set
          printf("    create set\n")  if($debug);
          $token = next_token(\$newick, "[(:,)");
          $state = 1;
          $bracket_level++;
          $lastset = $node;
        } else {
          $state = 2;
        }
      }
      case 2 { #naming a node
        if(!($token =~ /[\[\:\,\)\;]/)) { 
          $node->name($token);
          if($debug) { print("    naming leaf"); $node->print_node; }
          $token = next_token(\$newick, "[:,);");
        }
        $state = 3;
      }
      case 3 { # optional : and distance
        if($token eq ':') {
          $token = next_token(\$newick, "[,);");
          $node->distance_to_parent($token);
          if($debug) { print("set distance: $token"); $node->print_node; }
          $token = next_token(\$newick, ",);"); #move to , or )
        } elsif ($token eq '[') { # NHX tag without previous blength
          $token .= next_token(\$newick, ",);");
        }
        $state = 4;
      }
      case 4 { # optional NHX tags
        if($token =~ /\[\&\&NHX/) {
            # careful: this regexp gets rid of all NHX wrapping in one step
            $token =~ /\[\&\&NHX\:(\S+)\]/;
            if ($1) {
                # NHX may be empty, presumably at end of file, just before ";"
                my @attributes = split ':', $1;
                foreach my $attribute (@attributes) {
                    $attribute =~ s/\s+//;
                    my($key,$value) = split '=', $attribute;
                    # we assume only one value per key
                    # shortcut duplication mapping
                    if ($key eq 'D') {
                      $key = "Duplication";
                      # this is a small hack that will work for
                      # treefam nhx trees
                      $value =~ s/Y/1/;
                      $value =~ s/N/0/;
                    }
                    if ($key eq 'DD') {
                      # this is a small hack that will work for
                      # treefam nhx trees
                      $value =~ s/Y/1/;
                      $value =~ s/N/0/;
                    }
                    $node->add_tag("$key","$value");
                }
            }
            # $token = next_token(\$newick, ",);");
            #$node->distance_to_parent($token);
            # Force a duplication = 0 for some strange treefam internal nodes
            unless ($node->is_leaf) {
              if (!defined($node->get_tagvalue("Duplication"))) {
                $node->add_tag("Duplication",0);
              }
            }
            if($debug) { print("NHX tags: $token"); $node->print_node; }
            $token = next_token(\$newick, ",);"); #move to , or )
        }
        $state = 5;
      }
      case 5 { # end node
        if($token eq ')') {
          if($debug) { print("end set : "); $lastset->print_node; }
          $node = $lastset;        
          $lastset = $lastset->parent;
          $token = next_token(\$newick, "[:,);"); 
          # it is possible to have anonymous internal nodes no name
          # no blength but with NHX tags
          if ($token eq '[') {
              $state=1;
          } else {
              $state=2;
          }
          $bracket_level--;
        } elsif($token eq ',') {
          $token = next_token(\$newick, "[(:,)"); #can be un_blengthed nhx nodes
          $state=1;
        } elsif($token eq ';') {
          #done with tree
          throw("parse error: unbalanced ()\n") if($bracket_level ne 0);
          $state=13;
          $token = next_token(\$newick, "(");
        } else {
          throw("parse error: expected ; or ) or ,\n");
        }
      }

      case 13 {
        throw("parse error: nothing expected after ;");
      }
    }
  }
  return $root;

  Contact Jessica Severin on implemetation/design detail: jessica@ebi.ac.uk
  Contact Ewan Birney on EnsEMBL in general: birney@sanger.ac.uk