Newick形式を与え、生物種名で色分けされた系統樹をiTolで書く

gistfile1.pl

#!/usr/bin/env perl

use strict;
use warnings;

use LWP::Simple;

if ( scalar @ARGV != 1) {
    die "Usage: perl $0 input.newick\n";
}

open my $fh, '<', $ARGV[0] || die $!;
while ( my $infile = <$fh> ) {
    
    # Parsing Newick format
    $infile =~ s/[()]//g;
    $infile =~ s/\,/\n/g;
    
    while ( $infile =~ m/(\d+\_\w+)\:/g ) {
	my $id = $1;
	my (undef, undef, $uniprot) = split /\_/, $id;
	
	my $swiss = "http://togows.dbcls.jp/entry/uniprot/$uniprot";
	my $flat = get($swiss);
	
	if ( !$flat ) {
	    print "Error: Can not access to $uniprot";
	}
	
	# Taxonomy
	$flat =~ m/OC\s+(\w+)/;
	my $OC = $1;
	
	my %color = (
		     Eukaryota => "#ff3399",
		     Bacteria  => "#6633ff",
		     Archea    => "#99cc00",
		     );
		     
	my $length = length $id;
	if ( $length == 62 || $length == 63 || $length == 64 ){
	    
	    # iTol output format
	    if ( $OC eq "Eukaryota" ) {
		print "$id\t", "range\t", "$color{Eukaryota}\t", $OC,  "\n";
	    }
	    
	    elsif ( $OC eq "Bacteria" ){
		print "$id\t", "range\t", "$color{Bacteria}\t", $OC,  "\n";
	    }
	    
	    elsif ( $OC eq "Archaea" ) {
		print "$id\t", "range\t", "$color{Archea}\t", $OC,  "\n";
	    }
	}
	sleep (2);
    }
}