view release on metacpan or  search on metacpan

bin/format-tree.pl  view on Meta::CPAN

#!/usr/bin/env perl
# PODNAME: format-tree.pl
# ABSTRACT: Format (and annotate) trees for printing
# CONTRIBUTOR: Valerian LUPO <valerian.lupo@doct.uliege.be>

use Modern::Perl '2011';
use autodie;

use Getopt::Euclid qw(:vars);
use Smart::Comments;
use Try::Tiny;

use Bio::MUST::Core;
use Bio::MUST::Core::Utils qw(:filenames secure_outfile);
use aliased 'Bio::MUST::Core::IdList';
use aliased 'Bio::MUST::Core::IdMapper';
use aliased 'Bio::MUST::Core::Taxonomy';
use aliased 'Bio::MUST::Core::Tree';

# TODO: implement numbered taxonomic levels as in fetch-tax.pl
# check for conditionally required arguments
die <<'EOT' if !$ARGV_annotate && ($ARGV_collapse || $ARGV_colorize);
Missing required arguments:
    --annotate=<level>
EOT

die <<'EOT' if !$ARGV_taxdir && ($ARGV_annotate || $ARGV_auto_final_ids);
Missing required arguments:
    --taxdir=<dir>
EOT

# optionally read global org-mapper
my $org_mapper;
if ($ARGV_org_mapper) {
    ### Mapping organisms from: $ARGV_org_mapper
    $org_mapper = IdMapper->load($ARGV_org_mapper);
}

# optionally build taxonomy object
my $tax;
if ($ARGV_taxdir) {
    ### Annotating tree using: $ARGV_taxdir
    $tax = Taxonomy->new_from_cache( tax_dir => $ARGV_taxdir );
}

# setup collapsing and group naming
my $annotate_key;
my $collapse_key;
if ($ARGV_collapse && ($ARGV_collapse =~ m/label|color/xms)) {
    $annotate_key  = 'taxon_label' if $ARGV_annotate eq 'missing';
    $collapse_key  = 'taxon_label' if $ARGV_collapse eq 'label';
    $collapse_key  = '!color'      if $ARGV_collapse eq 'color';
    $ARGV_collapse = 'no rank';
}
$ARGV_annotate = 'no rank' if $ARGV_annotate && $ARGV_annotate eq 'missing';
my %opts = (name  => $ARGV_annotate);
$opts{  collapse} =  $ARGV_collapse if $ARGV_collapse;

TREE:
for my $infile (@ARGV_infiles) {

    ### Processing: $infile
    my $tree;
    try   { $tree = Tree->load($infile) }
    catch { warn "Warning: cannot load '$infile' as a Tree; skipping!\n" };
    next TREE unless $tree;