view release on metacpan or  search on metacpan

bin/generate_bgc_dnz_table.pl  view on Meta::CPAN

#!/usr/bin/env perl
# PODNAME: generate_bgc_dnz_table.pl
# ABSTRACT: Generates a denormalized table for BGC data
# CONTRIBUTOR: Denis BAURAIN <denis.baurain@uliege.be>

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

use Smart::Comments;

use Carp;
use File::Basename qw(fileparse);
use Getopt::Euclid qw(:vars);
use Path::Class qw(dir file);

use aliased 'Bio::Palantir::Parser';
use aliased 'Bio::Palantir::Refiner::ClusterPlus';


# check BGC type
if (@ARGV_types) {
    Parser->is_cluster_type_ok(@ARGV_types);
}

# report parsing
my $report = Parser->new( file => $ARGV_report_file );
my $root = $report->root;

my @clusters
    = $ARGV_annotation eq 'palantir'
    ? map { ClusterPlus->new( _cluster => $_ ) } $root->all_clusters
    : $root->all_clusters
;

my @lines;
for my $cluster (@clusters) {

    if (@ARGV_types) {
        next unless
            grep { $cluster->type =~ m/$_/xmsi } @ARGV_types;
    }

    for my $gene ($cluster->all_genes) {

        for my $domain ($gene->all_domains) {

            my $prot_coordinates = $domain->coordinates;
            my $prot_size = $domain->size;

            my $gene_coordinates = $gene->genomic_dna_coordinates;
            my $gene_size = $gene->genomic_dna_size;
            
            my $cluster_coordinates = $cluster->genomic_dna_coordinates;
            my $cluster_size = $cluster->genomic_dna_size;

            push @lines, 
                [ 
                    $ARGV_id // $ARGV_report_file,
                    $root->count_clusters, $root->count_genes,
                    $root->count_domains, $root->count_motifs,
                    $cluster->rank, $cluster->type, @$cluster_coordinates, 
                    $cluster_size, $cluster->count_genes, $gene->count_domains,
                    $gene->rank, $gene->name, @$gene_coordinates, $gene_size,
                    $gene->count_domains, 
                    $domain->rank, $domain->function, $domain->subtype, 
                    @$prot_coordinates, $prot_size,