kkonganti@17: #!/usr/bin/env perl
kkonganti@17: 
kkonganti@17: use strict;
kkonganti@17: use FindBin;
kkonganti@17: use Bio::SeqIO;
kkonganti@17: use Bio::Seq;
kkonganti@17: use Path::Tiny;
kkonganti@17: use File::Basename;
kkonganti@17: use File::Spec;
kkonganti@17: use File::Path qw(make_path remove_tree);
kkonganti@17: use List::Util qw(first);
kkonganti@17: use Cwd        qw(abs_path);
kkonganti@17: use Data::Dumper;
kkonganti@17: use LWP::Simple;
kkonganti@17: use JSON;
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: # Globals
kkonganti@17: 
kkonganti@17: my $EXE     = basename($0);
kkonganti@17: my $ABX_SEP = ';';
kkonganti@17: 
kkonganti@17: my %DATABASE = (
kkonganti@17:     'resfinder'     => \&get_resfinder,
kkonganti@17:     'plasmidfinder' => \&get_plasmidfinder,
kkonganti@17:     'megares'       => \&get_megares,
kkonganti@17:     'argannot'      => \&get_argannot,
kkonganti@17:     'card'          => \&get_card,
kkonganti@17: 
kkonganti@17:     #  'ncbibetalactamase' => \&get_ncbibetalactamase,
kkonganti@17:     'ncbi'     => \&get_ncbi,
kkonganti@17:     'vfdb'     => \&get_vfdb,
kkonganti@17:     'ecoli_vf' => \&get_ecoli_vf,    # https://github.com/phac-nml/ecoli_vf
kkonganti@17:     'ecoh'     => \&get_ecoh,
kkonganti@17:     'bacmet2'  => \&get_bacmet2,
kkonganti@17:     'victors'  => \&get_victors,
kkonganti@17: 
kkonganti@17:     #  'serotypefinder'    => \&get_serotypefinder,
kkonganti@17: );
kkonganti@17: my $DATABASES = join( ' ', sort keys %DATABASE );
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: # Command line options
kkonganti@17: 
kkonganti@17: my ( @Options, $debug, $outdir, $db, $force );
kkonganti@17: setOptions();
kkonganti@17: 
kkonganti@17: $db                   or err("Please choose a --db from: $DATABASES");
kkonganti@17: exists $DATABASE{$db} or err("Unknown --db '$db', choose from: $DATABASES ");
kkonganti@17: -d $outdir            or err("--outdir '$outdir' does not exist");
kkonganti@17: 
kkonganti@17: my $dir = abs_path( File::Spec->catdir( $outdir, $db ) );
kkonganti@17: make_path($dir);
kkonganti@17: msg("Setting up '$db' in '$dir'");
kkonganti@17: 
kkonganti@17: #my $tmpdir = tempdir("$db-XXXXXXXX", DIR=>$dir, CLEANUP=>0);
kkonganti@17: #my $tmpdir = "/home/tseemann/git/abricate/db/resfinder/resfinder-6Kuphtvv";
kkonganti@17: my $tmpdir = "$dir/src";
kkonganti@17: make_path($tmpdir);
kkonganti@17: 
kkonganti@17: # run the specific function from --db
kkonganti@17: chdir $tmpdir;
kkonganti@17: my $seq = $DATABASE{$db}->();
kkonganti@17: map { is_full_gene($_) } @$seq;    # doesn't do anything?
kkonganti@17: $seq = dedupe_seq($seq);
kkonganti@17: 
kkonganti@17: #print Dumper($seq);
kkonganti@17: msg("Sorting sequences by ID");
kkonganti@17: $seq = [ sort { $a->{ID} cmp $b->{ID} } @$seq ];
kkonganti@17: save_fasta( "$dir/sequences", $seq );
kkonganti@17: 
kkonganti@17: msg("Formatting BLASTN database: $dir/sequences");
kkonganti@17: my $logfile    = "$tmpdir/makeblastdb.log";
kkonganti@17: my $ncbi_title = $db;
kkonganti@17: if ( "$db" eq "ncbi" ) {
kkonganti@17:     $ncbi_title = "ncbiamrplus";
kkonganti@17: }
kkonganti@17: my $ec = system(
kkonganti@17: "makeblastdb -in '$dir/sequences' -title '$ncbi_title' -dbtype nucl -hash_index -logfile $logfile"
kkonganti@17: );
kkonganti@17: if ( $ec != 0 ) {
kkonganti@17:     system("tail '$logfile'");
kkonganti@17:     err("Error with makign BLAST database. See $logfile");
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #msg("Run 'abricate --setupdb' to format the database");
kkonganti@17: 
kkonganti@17: msg("Done.");
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: 
kkonganti@17: sub download {
kkonganti@17:     my ( $url, $dest ) = @_;
kkonganti@17:     if ( -r $dest and not $force ) {
kkonganti@17:         msg("Won't re-download existing $dest (use --force)");
kkonganti@17: 
kkonganti@17:         #exit(1);
kkonganti@17:     }
kkonganti@17:     else {
kkonganti@17:         msg("Downloading: $url");
kkonganti@17:         my $ec = mirror( $url, $dest );
kkonganti@17:         msg("HTTP Result: $ec");
kkonganti@17:         ( $ec == 200 or $ec = 304 )
kkonganti@17:           or err("HTTP $ec | failed to download $url");    # is HTTP OK ?
kkonganti@17:     }
kkonganti@17:     msg("Destination: $dest");
kkonganti@17:     msg( "Filesize:", ( -s $dest ), "bytes" );
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub trim_spaces {
kkonganti@17:     my ($s) = @_;
kkonganti@17:     $s =~ s/^\s+//;
kkonganti@17:     $s =~ s/\s+$//;
kkonganti@17:     return $s;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_resfinder {
kkonganti@17:     my $name = "resfinder_db";
kkonganti@17: 
kkonganti@17:     # FIXME - can we just get HEAD.zip like in plasmidfinder?
kkonganti@17:     my $url = "https://bitbucket.org/genomicepidemiology/$name.git";
kkonganti@17: 
kkonganti@17:     #   if (-r $name and not $force) {
kkonganti@17:     #     msg("Won't overwrite existing $name (use --force)");
kkonganti@17:     # #    exit(1);
kkonganti@17:     #   }
kkonganti@17:     #   else {
kkonganti@17:     #     msg("Nuking existing folder: $name");
kkonganti@17:     #     remove_tree("./$name");
kkonganti@17:     #     msg("Cloning $url to $name");
kkonganti@17:     #     system("git clone --quiet $url $name");
kkonganti@17:     #   }
kkonganti@17: 
kkonganti@17:     #<*.fsa>
kkonganti@17:     #>aac(6')-Ib_2_M23634
kkonganti@17:     #>blaNDM-19_1_MF370080
kkonganti@17:     #>mcr-1.1_1_KP347127
kkonganti@17:     #>fosB1_1_CP001903
kkonganti@17:     #>fusB_1_AY373761
kkonganti@17:     #>VanHAX_1_FJ866609
kkonganti@17:     #>ere(A)_6_DQ157752
kkonganti@17:     #>nimA_1_X71444
kkonganti@17:     #>cfr_1_AM408573
kkonganti@17:     #>catB3_2_U13880
kkonganti@17:     #>qnrA1_1_AY070235
kkonganti@17:     #>ARR-2_1_HQ141279
kkonganti@17:     #>sul1_2_U12338
kkonganti@17:     #>tet_1_M74049
kkonganti@17:     #>dfrA19_1_EU855687
kkonganti@17: 
kkonganti@17:     #<notes.txt>
kkonganti@17:     #aac(6')-Iv:Aminoglycoside resistance:
kkonganti@17:     #aac(6')-Iw:Aminoglycoside resistance:Alternate name; aac(6')-Ix
kkonganti@17:     #sul3:Sulphonamide resistance:
kkonganti@17:     ##Tetracycline:
kkonganti@17:     #ort(B):Tetracycline resistance:
kkonganti@17:     #blaCMY-59:Beta-lactam resistance:
kkonganti@17: 
kkonganti@17: #<phenotypes.txt>
kkonganti@17: #Gene_accession no.      Class   Phenotype       PMID    Mechanism of resistance Notes Required_gene
kkonganti@17: #ant(2'')-Ia_1_X04555    Aminoglycoside  Gentamicin, Tobramycin  3024112 Enzymatic modification  Alternative name aadB
kkonganti@17: #ant(2'')-Ia_2_JF826500  Aminoglycoside  Gentamicin, Tobramycin  22271862        Enzymat
kkonganti@17: 
kkonganti@17:     $name = "~/apps/bettercallsal/assets/abricate_dbs/$name";
kkonganti@17:     my $metafn = "$name/phenotypes.txt";
kkonganti@17:     my @meta   = path($metafn)->lines( { chomp => 1 } );
kkonganti@17:     my %anno;
kkonganti@17:     foreach (@meta) {
kkonganti@17:         next if m/^#/;
kkonganti@17:         my @x = split m/\t/;
kkonganti@17: 
kkonganti@17:         #msg("$metafn: @x");
kkonganti@17:         my ($gene) = ( $x[0] =~ m/^(.*?)_\w+$/ );
kkonganti@17:         $anno{$gene}{ABX} = [
kkonganti@17:             map    { trim_spaces($_) }
kkonganti@17:               grep { !m/(unknown|notes|^none)/i }
kkonganti@17:               split m/,\s*/,
kkonganti@17:             $x[2]
kkonganti@17:         ];
kkonganti@17: 
kkonganti@17:         #msg("$metafn: $gene |", $anno{$gene}{ABX}->@*);
kkonganti@17:     }
kkonganti@17:     msg( "get_resfinder: $metafn", scalar( keys %anno ), "genes" );
kkonganti@17: 
kkonganti@17:     #print Dumper(\%anno);
kkonganti@17: 
kkonganti@17:     my @seq;
kkonganti@17:     for my $fasta (<$name/*.fsa>) {
kkonganti@17: 
kkonganti@17:         # Issue #62 - repair broken fasta files like this:
kkonganti@17:         # GCTTTAAATTGGAAAAAAGATAGTCAAACTCTTTAA>cmr_1_U43535
kkonganti@17:         # inline replacement
kkonganti@17:         system( 'sed', '-i.bak', 's/\([A-Z]\)>/\1\n>/gi', $fasta );
kkonganti@17:         my $args = load_fasta($fasta);
kkonganti@17: 
kkonganti@17:         # use name of fasta file as antibiotic name
kkonganti@17:         #my $abx = basename($fasta, '.fsa');
kkonganti@17:         #msg("$fasta: Assigning '$abx' to all genes");
kkonganti@17:         #push @{$_->{ABX}}, $abx for (@$args);
kkonganti@17:         push @seq, @$args;
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     # https://github.com/tseemann/abricate/issues/92
kkonganti@17:     # mcr-9_1_NZ_NAAN01000063.1
kkonganti@17:     #>mcr-9_1_NZ_NAAN01000063.1
kkonganti@17:     # mcr-9.1:Colistin resistance:
kkonganti@17: 
kkonganti@17:     for my $seq (@seq) {
kkonganti@17:         my ( $id, $copy, $acc ) = $seq->{ID} =~ m/^(.*?)_(\d+)_(\S+)$/;
kkonganti@17: 
kkonganti@17:         #msg("resfinder: $1 $2 $3", $anno{$1});
kkonganti@17:         $seq->{ID}   = "${id}_${copy}";
kkonganti@17:         $seq->{ACC}  = $acc;
kkonganti@17:         $seq->{DESC} = $anno{$id}{DESC} || $id;
kkonganti@17:         push @{ $seq->{ABX} }, @{ $anno{$id}{ABX} } if $anno{$id}{ABX};
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     return \@seq;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_serotypefinder {
kkonganti@17:     my $name = "serotypefinder_db";
kkonganti@17:     my $url  = "https://bitbucket.org/genomicepidemiology/$name.git";
kkonganti@17: 
kkonganti@17:     if ( -r $name and not $force ) {
kkonganti@17:         msg("Won't overwrite existing $name (use --force)");
kkonganti@17: 
kkonganti@17:         #    exit(1);
kkonganti@17:     }
kkonganti@17:     else {
kkonganti@17:         msg("Nuking existing folder: $name");
kkonganti@17:         remove_tree("./$name");
kkonganti@17:         msg("Cloning $url to $name");
kkonganti@17:         system("git clone --quiet $url $name");
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     my @seq;
kkonganti@17:     for my $fasta (<$name/*.fsa>) {
kkonganti@17:         push @seq, @{ load_fasta($fasta) };
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     # >fliC_44444_AY250028_H52
kkonganti@17:     # FIXME - this is already in EcOH database!
kkonganti@17:     for my $seq (@seq) {
kkonganti@17:         my ( $id, $copy, $acc ) = $seq->{ID} =~ m/^(.*)_(\d+)_(\w+)$/;
kkonganti@17: 
kkonganti@17:         #msg("serotypefinder: $1 $2 $3", $anno{$1});
kkonganti@17:         $seq->{ID}  = "${id}_${copy}";
kkonganti@17:         $seq->{ACC} = $acc;
kkonganti@17: 
kkonganti@17:         #$seq->{DESC} = $anno{$id} || '';
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     return \@seq;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_tag {
kkonganti@17:     my ( $f, $tag ) = @_;
kkonganti@17:     if ( $f->has_tag($tag) ) {
kkonganti@17:         my ($val) = $f->get_tag_values($tag);
kkonganti@17:         return $val;
kkonganti@17:     }
kkonganti@17:     return '';
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_ncbi {
kkonganti@17:     my $AFP =
kkonganti@17: "https://ftp.ncbi.nlm.nih.gov/pathogen/Antimicrobial_resistance/AMRFinderPlus/database/latest";
kkonganti@17: 
kkonganti@17: #my $src = "https://ftp.ncbi.nlm.nih.gov/pathogen/Antimicrobial_resistance/AMRFinderPlus/data/latest/AMR_CDS";
kkonganti@17:     my $src  = "$AFP/AMR_CDS";
kkonganti@17:     my $name = "amr_cds.ffn";
kkonganti@17: 
kkonganti@17: #my $src2 = "https://ftp.ncbi.nlm.nih.gov/pathogen/Antimicrobial_resistance/AMRFinderPlus/data/latest/ReferenceGeneCatalog.txt";
kkonganti@17:     my $src2  = "$AFP/ReferenceGeneCatalog.txt";
kkonganti@17:     my $name2 = "amr_cds.tsv";
kkonganti@17: 
kkonganti@17:     if ( -r $name and -r $name2 and not $force ) {
kkonganti@17:         msg("Won't overwrite existing $name/$name2 (use --force)");
kkonganti@17: 
kkonganti@17:         #    exit(1);
kkonganti@17:     }
kkonganti@17:     else {
kkonganti@17:         download( $src,  $name );
kkonganti@17:         download( $src2, $name2 );
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     #1   allele
kkonganti@17:     #2   gene_family                   ble
kkonganti@17:     #3   whitelisted_taxa
kkonganti@17:     #4   product_name                  BLMA family bleomycin binding protein
kkonganti@17:     #5   scope                         core
kkonganti@17:     #6   type                          AMR
kkonganti@17:     #7   subtype                       AMR
kkonganti@17:     #8   class                         BLEOMYCIN
kkonganti@17:     #9   subclass                      BLEOMYCIN
kkonganti@17:     #10  refseq_protein_accession      WP_063842967.1
kkonganti@17:     #11  refseq_nucleotide_accession   NG_047554.1
kkonganti@17:     #12  curated_refseq_start          No
kkonganti@17:     #13  genbank_protein_accession     CAA02068.1
kkonganti@17:     #14  genbank_nucleotide_accession  A31900.1
kkonganti@17:     #15  genbank_strand_orientation    +
kkonganti@17:     #16  genbank_cds_start             6
kkonganti@17:     #17  genbank_cds_stop              374
kkonganti@17:     #18  pubmed_reference
kkonganti@17:     #19  blacklisted_taxa
kkonganti@17:     #20  db_version                    2019-08-27.1
kkonganti@17: 
kkonganti@17:     my $tsv = load_tabular( $name2, 10 );    # refseq_nucleotide_accession
kkonganti@17:     msg( "[$name2] Loaded", scalar keys %$tsv, "records" );
kkonganti@17: 
kkonganti@17: # https://github.com/ncbi/amr/wiki/AMRFinderPlus-database#amrprot
kkonganti@17: #  0          1              2         3 4 5          6      7
kkonganti@17: # >1000909371|WP_061158039.1|NG_050200|1|1|blaTEM-156|blaTEM|class_A_beta-lactamase_TEM-156 NG_050200:101-961
kkonganti@17:     my @seq;
kkonganti@17:     my $in = Bio::SeqIO->new( -file => $name, -format => "fasta" );
kkonganti@17:     while ( my $rec = $in->next_seq ) {
kkonganti@17: 
kkonganti@17:         # parse ID
kkonganti@17:         my ( $gi, $pi, $acc, $fp, $fn, $gene, $fam, $prod ) = split m/\|/,
kkonganti@17:           $rec->id;
kkonganti@17: 
kkonganti@17:         # skip fusion genes
kkonganti@17:         next unless $fp == 1 and $fn == 1;
kkonganti@17: 
kkonganti@17:         # only keep true ARGs
kkonganti@17:         $acc .= ".1" unless $acc =~ m/\.\d+$/;
kkonganti@17:         my $t = $tsv->{$acc} or next;
kkonganti@17:         next unless ( $t->{scope} eq 'plus' || $t->{scope} eq 'core' );
kkonganti@17: 
kkonganti@17:         # next unless $t->{type} eq 'VIRULENCE';
kkonganti@17:         # next unless $t->{subtype} eq 'VIRULENCE';
kkonganti@17:         # construct sequence record
kkonganti@17:         $prod =~ s/_/ /g;
kkonganti@17:         err("$pi: gene is empty")    unless $gene;
kkonganti@17:         err("$pi: product is empty") unless $prod;
kkonganti@17:         my $s = {
kkonganti@17:             ID   => $gene,
kkonganti@17:             ACC  => $acc,
kkonganti@17:             DESC => $prod,
kkonganti@17:             SEQ  => $rec->seq,
kkonganti@17:             ABX  => [ split m'/', $t->{subclass} ]
kkonganti@17:         };
kkonganti@17:         push @seq, $s;
kkonganti@17:         msg( "[$name]", 0 + @seq, "|", $s->{ID}, "|", $s->{ACC}, "|",
kkonganti@17:             $s->{DESC} );
kkonganti@17: 
kkonganti@17:         #msg(Dumper($s));
kkonganti@17:         msg( $s->{ID}, " is fusion $fp/$fn" ) if "$fp$fn" ne '11';
kkonganti@17:     }
kkonganti@17:     return \@seq;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_plasmidfinder {
kkonganti@17:     my $name = "plasmidfinder";
kkonganti@17:     my $zip  = "$name.zip";
kkonganti@17: 
kkonganti@17: #  download("https://cge.cbs.dtu.dk/cge/download_data.php?folder=$name&filename=$zip&submit=$zip", $zip);
kkonganti@17:     download(
kkonganti@17: "https://bitbucket.org/genomicepidemiology/plasmidfinder_db/get/HEAD.zip",
kkonganti@17:         $zip
kkonganti@17:     );
kkonganti@17:     system("unzip -j -u $zip");
kkonganti@17: 
kkonganti@17:     my @seq;
kkonganti@17:     for my $fasta (<*.fsa>) {
kkonganti@17:         push @seq, @{ load_fasta($fasta) };
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     for my $seq (@seq) {
kkonganti@17:         $seq->{DESC} = $seq->{ID};    # no desc, so use ORIGINAL ID as desc
kkonganti@17:         my ( $id, $acc ) =
kkonganti@17:           ( $seq->{ID} =~ m/^(.*)_(([A-Z]+|NC_)\d+(\.\d+)?)$/ );
kkonganti@17:         $id =~ s/_+$//g;
kkonganti@17:         $seq->{ID}  = $id  || $seq->{ID};
kkonganti@17:         $seq->{ACC} = $acc || '';
kkonganti@17:         wrn( "Parsed empty ID:",
kkonganti@17:             $seq->{DESC},
kkonganti@17:             "=> id='$id' acc='$acc' seq=" . substr( $seq->{SEQ}, 0, 10 ) )
kkonganti@17:           if not $id;
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     return \@seq;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_megares {
kkonganti@17:     my $zip = "megares.zip";
kkonganti@17:     download( 'https://www.meglab.org/downloads/megares_v3.00.zip', $zip );
kkonganti@17:     system("unzip -j -u $zip");
kkonganti@17:     my $seqs = load_fasta( glob("megares_drugs_*.fasta") );
kkonganti@17:     my @okseq;
kkonganti@17: 
kkonganti@17: # >MEG_372|Multi-compound|Drug_and_biocide_resistance|Drug_and_biocide_MATE_efflux_pumps|ABEM
kkonganti@17: # >MEG_411|Multi-compound|Drug_and_biocide_resistance|Drug_and_biocide_RND_efflux_regulator|ACRR|RequiresSNPConfirmation
kkonganti@17: # >MEG_7860|Drugs|betalactams|Class_B_betalactamases|ZOG
kkonganti@17: # >MEG_7439|Drugs|Glycopeptides|VanI-type_resistance_protein|VANI
kkonganti@17: # >MEG_7245|Drugs|Tetracyclines|Tetracycline_resistance_MFS_efflux_pumps|TETY
kkonganti@17: # >MEG_9|Drugs|Aminoglycosides|Aminoglycoside-resistant_16S_ribosomal_subunit_protein|A16S|RequiresSNPConfirmation
kkonganti@17: 
kkonganti@17:     for my $s (@$seqs) {
kkonganti@17:         my ( $id, $type, $class, $mech, $group, $note ) = split m/\|/, $s->{ID};
kkonganti@17:         if ($note) {
kkonganti@17: 
kkonganti@17:             # "RequiresSNPConfirmation" is the common one; we can't do that
kkonganti@17:             msg("Skipping $id due to: $note");
kkonganti@17:             next;
kkonganti@17:         }
kkonganti@17:         $s->{ID}   = $group;
kkonganti@17:         $s->{ACC}  = $id;
kkonganti@17:         $s->{DESC} = join( ':', $type, $class, $mech, $group );
kkonganti@17:         push @okseq, $s;
kkonganti@17:     }
kkonganti@17:     return [@okseq];
kkonganti@17: 
kkonganti@17:     #return $seqs;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_argannot {
kkonganti@17:     my $fasta = 'arg-annot.fa';
kkonganti@17:     download(
kkonganti@17: #    'http://www.mediterranee-infection.com/arkotheque/client/ihumed/_depot_arko/articles/1425/argannot-aa-v3-march2017_doc.fasta',
kkonganti@17: #    'http://www.mediterranee-infection.com/arkotheque/client/ihumed/_depot_arko/articles/691/argannot-nt_doc.fasta',
kkonganti@17: 'https://www.mediterranee-infection.com/wp-content/uploads/2019/06/ARG_ANNOT_V5_Nt_JUNE2019.txt',
kkonganti@17:         $fasta
kkonganti@17:     );
kkonganti@17: 
kkonganti@17:     # fix syntax errors in the FASTA file...
kkonganti@17:     path($fasta)->edit( sub { s/\\//g; $_ } );
kkonganti@17: 
kkonganti@17:     my $seqs = load_fasta($fasta);
kkonganti@17: 
kkonganti@17:     #  0             1         2               3
kkonganti@17:     # >(AGly)Aac2-Ie:NC_011896:3039059-3039607:549
kkonganti@17:     for my $s (@$seqs) {
kkonganti@17:         my @x = split m/:/, $s->{ID};
kkonganti@17:         $s->{ID}   = $x[0];
kkonganti@17:         $s->{ACC}  = $x[1] . ':' . $x[2];
kkonganti@17:         $s->{DESC} = '';
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     return $seqs;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_bacmet2 {
kkonganti@17:     my $fasta = 'bacmet2.fa';
kkonganti@17:     download(
kkonganti@17:         'http://bacmet.biomedicine.gu.se/download/BacMet2_EXP_database.fasta',
kkonganti@17:         $fasta );
kkonganti@17: 
kkonganti@17:     # This is a PROTEIN file
kkonganti@17:     my $seqs = load_fasta($fasta);
kkonganti@17: 
kkonganti@17:     #  0       1    2  3      4         ^
kkonganti@17:     # >BAC0098|ctpC|sp|P0A502|CTPC_MYCTU Probable manganese/zinc-exporting
kkonganti@17:     for my $s (@$seqs) {
kkonganti@17:         my @x = split m/\|/, $s->{ID};
kkonganti@17:         $s->{ID}  = $x[1] . '-' . $x[0];
kkonganti@17:         $s->{ACC} = $x[2] . ':' . $x[3];
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     return $seqs;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_card {
kkonganti@17: 
kkonganti@17:     # https://github.com/tseemann/abricate/issues/25
kkonganti@17:     my $tarball = 'card.tar.bz2';
kkonganti@17:     download(
kkonganti@17:         #'https://card.mcmaster.ca/download/0/broadstreet-v2.0.2.tar.gz',
kkonganti@17:         'https://card.mcmaster.ca/latest/data',
kkonganti@17: 
kkonganti@17:         #'https://card.mcmaster.ca/latest/data/card-data.tar.bz2',
kkonganti@17:         $tarball    # yes, it's really BZ2 not GZ ...
kkonganti@17:     );
kkonganti@17: 
kkonganti@17:     #  my $fasta = "./nucleotide_fasta_protein_homolog_model.fasta";
kkonganti@17:     my $jsonfile = "./card.json";
kkonganti@17:     system( "tar", "xf", $tarball, $jsonfile ) == 0
kkonganti@17:       or err("Problem with tar xf $tarball $jsonfile");
kkonganti@17:     -r $jsonfile or err("Could not extract $jsonfile from $tarball");
kkonganti@17: 
kkonganti@17:     # JSON
kkonganti@17:     my $json = path($jsonfile)->slurp_utf8;
kkonganti@17:     my $card = from_json( $json, { latin1 => 1 } );
kkonganti@17:     my @seq;
kkonganti@17:     for my $g ( values %$card ) {
kkonganti@17:         next unless ref($g) eq 'HASH';
kkonganti@17: 
kkonganti@17:         #    msg(Dumper($g));
kkonganti@17:         next
kkonganti@17:           unless $g->{model_type} eq
kkonganti@17:           "protein homolog model";    # only 'acquired' genes
kkonganti@17:         my $id = $g->{model_name};
kkonganti@17:         err("$id has {model_param}{snp}") if exists $g->{model_param}{snp};
kkonganti@17: 
kkonganti@17:         #    msg("CARD: $id");
kkonganti@17:         #    print STDERR Dumper($g);
kkonganti@17:         my $dna = $g->{model_sequences}{sequence}
kkonganti@17:           or err("$id: no {model_sequences}{sequence} found");
kkonganti@17:         my ($key) = sort keys %$dna;    # first key
kkonganti@17:         $dna = $dna->{$key}         or err("$id: invalid key '$key'");
kkonganti@17:         $dna = $dna->{dna_sequence} or err("$id: no dna_sequence");
kkonganti@17: 
kkonganti@17:         #    msg(Dumper($dna)) if $id eq 'OXA-25';
kkonganti@17: 
kkonganti@17:         # ARO_category => {
kkonganti@17:         #	'category_aro_name' => 'cephalosporin',
kkonganti@17:         #	'category_aro_class_name' => 'Drug Class',
kkonganti@17:         my $is_amr_gene = 0;
kkonganti@17:         my @abx;
kkonganti@17:         for my $key ( keys $g->{ARO_category}->%* ) {
kkonganti@17:             my $c = $g->{ARO_category}{$key};
kkonganti@17:             if ( $c->{category_aro_class_name} eq 'Drug Class' ) {
kkonganti@17:                 my $abx = $c->{category_aro_name};
kkonganti@17:                 $abx =~ s/ antibiotic//;
kkonganti@17:                 $abx =~ s/\s/_/g;
kkonganti@17:                 push @abx, $abx;
kkonganti@17:             }
kkonganti@17:             if ( $c->{category_aro_class_name} eq 'AMR Gene Family' ) {
kkonganti@17:                 $is_amr_gene++;
kkonganti@17:             }
kkonganti@17:         }
kkonganti@17: 
kkonganti@17:         #err("CARD | $id | ", Dumper($g->{ARO_category}) ) unless $is_amr_gene;
kkonganti@17:         #msg("ABX=$_") for @abx;
kkonganti@17: 
kkonganti@17:         # put coordinates into normal form
kkonganti@17:         my ( $start, $stop ) =
kkonganti@17:           $dna->{strand} eq '-'
kkonganti@17:           ? ( $dna->{fmax}, $dna->{fmin} )
kkonganti@17:           : ( $dna->{fmin}, $dna->{fmax} );
kkonganti@17: 
kkonganti@17:         $id =~ s/\s+/_/g;
kkonganti@17:         push @seq,
kkonganti@17:           {
kkonganti@17:             ID   => $id,
kkonganti@17:             ACC  => $dna->{accession} . ":$start-$stop",
kkonganti@17:             DESC => ( $g->{ARO_description} || $g->{ARO_accession} ),
kkonganti@17:             SEQ  => $dna->{sequence},
kkonganti@17:             ABX  => [@abx],
kkonganti@17:           };
kkonganti@17: 
kkonganti@17:         #    msg(Dumper($seq[-1]));
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     return \@seq;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_victors {
kkonganti@17: 
kkonganti@17:     # the CDS data is in .ffn and has source GI and coords
kkonganti@17:     # the PROT data is in .faa and has the protein ref and /product
kkonganti@17: 
kkonganti@17:   #>gi|115534241:2616-3152 Campylobacter jejuni plasmid pCJ01, complete sequence
kkonganti@17:     download( 'http://www.phidias.us/victors/downloads/gen_downloads.php',
kkonganti@17:         'victors.ffn' );
kkonganti@17: 
kkonganti@17: #>gi|115534244|ref|YP_783826.1| hypothetical protein pCJ01p4 [Campylobacter jejuni]
kkonganti@17:     download(
kkonganti@17:         'http://www.phidias.us/victors/downloads/gen_downloads_protein.php',
kkonganti@17:         'victors.faa' );
kkonganti@17: 
kkonganti@17:     my %gi;
kkonganti@17:     open my $FAA, '<', 'victors.faa';
kkonganti@17:     while (<$FAA>) {
kkonganti@17: 
kkonganti@17: #>gi|115534244|ref|YP_783826.1| hypothetical protein pCJ01p4 [Campylobacter jejuni]
kkonganti@17:         next unless m"^>gi.(\d+).ref.([^|]+). ([^[]+)";
kkonganti@17:         $gi{$1}{ACC}  = $2;
kkonganti@17:         $gi{$1}{DESC} = $3;
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     my $seqs = load_fasta("victors.ffn");
kkonganti@17: 
kkonganti@17:     for my $s (@$seqs) {
kkonganti@17: 
kkonganti@17:   #>gi|115534241:2616-3152 Campylobacter jejuni plasmid pCJ01, complete sequence
kkonganti@17:         $s->{ID} =~ m/gi.(\d+):(\d+)-(\d+)/;
kkonganti@17:         $s->{ACC} = $gi{$1}{ACC}    || "gi|$1:$2-$3";
kkonganti@17:         $s->{DESC} =~ $gi{$1}{DESC} || 'hypothetical protein';
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     #  print Dumper($seqs); exit;
kkonganti@17: 
kkonganti@17:     return $seqs;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_vfdb {
kkonganti@17:     download( 'http://www.mgc.ac.cn/VFs/Down/VFDB_setA_nt.fas.gz',
kkonganti@17:         'vfdb.fa.gz' );
kkonganti@17:     system("gzip -f -d -c vfdb.fa.gz > vfdb.fa");
kkonganti@17:     my $seqs = load_fasta("vfdb.fa");
kkonganti@17: 
kkonganti@17: # >VFG000676(gb|AAD32411) (lef) anthrax toxin lethal factor precursor [Anthrax toxin (VF0142)] [Bacillus anthracis str. Sterne]
kkonganti@17:     for my $s (@$seqs) {
kkonganti@17: 
kkonganti@17: # https://github.com/tseemann/abricate/issues/64#issuecomment-421895159 by @VGalata
kkonganti@17:         $s->{ID} =~ m/^(\w+)\(\w+\|(\w+)(\.\d+)?\)$/;    #
kkonganti@17:             #$s->{ID} =~ m/^(\w+)\(\w+\|(\w+)\)$/;
kkonganti@17:         $s->{ACC} = $2 if $2;
kkonganti@17:         $s->{DESC} =~ m/^\((.*?)\)/;
kkonganti@17:         $s->{ID} = $1 if $1;
kkonganti@17: 
kkonganti@17:         #    print STDERR Dumper($s); exit;
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     return $seqs;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_ncbibetalactamase {
kkonganti@17:     my $fasta = "ncbi.fa";
kkonganti@17:     download(
kkonganti@17:         'ftp://ftp.ncbi.nlm.nih.gov/pathogen/betalactamases/Allele-dna.fa',
kkonganti@17:         $fasta );
kkonganti@17:     my $tab = "ncbi.tab";
kkonganti@17:     download( 'ftp://ftp.ncbi.nlm.nih.gov/pathogen/betalactamases/Allele.tab',
kkonganti@17:         $tab );
kkonganti@17: 
kkonganti@17:     # >ACD12694.1 EU650653.1:1-1173
kkonganti@17:     my $seqs = load_fasta($fasta);
kkonganti@17: 
kkonganti@17: # ACC-1 ACD12694.1 EU650653.1 blaACC-1 1 1173 + cephalosporin-hydrolyzing class C beta-lactamase ACC-1
kkonganti@17:     my %anno;
kkonganti@17:     my @anno = grep { !m/^#/ } path($tab)->lines( { chomp => 1 } );
kkonganti@17:     msg( "Read", 0 + @anno, "annotations" );
kkonganti@17:     foreach (@anno) {
kkonganti@17:         my ( $name, $id, $acc, $gene, $begin, $end, undef, $product ) =
kkonganti@17:           split m/\t/;
kkonganti@17:         $anno{$id} = {
kkonganti@17:             ID   => $gene,
kkonganti@17:             DESC => $product,
kkonganti@17:             ACC  => "$acc:$begin-$end",
kkonganti@17:         };
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     #  print Dumper(\%anno);
kkonganti@17: 
kkonganti@17:     for my $s (@$seqs) {
kkonganti@17:         my $id = $s->{ID};
kkonganti@17:         next unless exists $anno{$id};
kkonganti@17:         $s->{ID}   = $anno{$id}{ID};
kkonganti@17:         $s->{ACC}  = $anno{$id}{ACC};
kkonganti@17:         $s->{DESC} = $anno{$id}{DESC};
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     #  print Dumper($seqs);
kkonganti@17: 
kkonganti@17:     return $seqs;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_ecoh {
kkonganti@17:     my $fasta = "EcOH.fa";
kkonganti@17:     download(
kkonganti@17: 'https://raw.githubusercontent.com/katholt/srst2/master/data/EcOH.fasta',
kkonganti@17:         $fasta
kkonganti@17:     );
kkonganti@17: 
kkonganti@17: # https://github.com/katholt/srst2#generating-srst2-compatible-clustered-database-from-raw-sequences
kkonganti@17: # [clusterID]__[gene]__[allele]__[seqID] [other stuff]
kkonganti@17: # >1__fliC__fliC-H1__1 AB028471.1;flagellin;H1
kkonganti@17: # >8__wzx__wzx-O41__246 AB811617.1;O antigen flippase;O41
kkonganti@17: # >9__wzy__wzy-OgN31__597 LC125932.1;O antigen polyermase;OgN31
kkonganti@17:     my $seqs = load_fasta($fasta);
kkonganti@17: 
kkonganti@17:     for my $s (@$seqs) {
kkonganti@17:         my @id   = split m/__/, $s->{ID};
kkonganti@17:         my @desc = split m';',  $s->{DESC};
kkonganti@17:         $s->{ID}   = $id[2];
kkonganti@17:         $s->{ACC}  = shift(@desc);
kkonganti@17:         $s->{DESC} = join( ' ', @desc );
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     #  print Dumper($seqs);
kkonganti@17:     return $seqs;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub get_ecoli_vf {
kkonganti@17:     my $fasta = "ecoli_vf.ffn";
kkonganti@17:     download(
kkonganti@17: 'https://github.com/phac-nml/ecoli_vf/raw/master/data/repaired_ecoli_vfs_shortnames.ffn',
kkonganti@17:         $fasta
kkonganti@17:     );
kkonganti@17:     my $seqs = load_fasta($fasta);
kkonganti@17: 
kkonganti@17: # >VFG000748(gi:2865308) (espF) EspF [EspF (VF0182)] [Escherichia coli O127:H6 str. E2348/69]
kkonganti@17: # >VFG000749(gi:6009379) (bfpA) Bundlin [BFP (VF0174)] [Escherichia coli B171]
kkonganti@17: # >SPG000142 (cvac) Escherichia coli cvi cvaC operon. [X57525 434-745]
kkonganti@17: # >SPG000143 (iss2) Escherichia coli Iss (iss) gene, complete cds. [AF042279 292-600]
kkonganti@17: 
kkonganti@17:     for my $s (@$seqs) {
kkonganti@17: 
kkonganti@17:         #print STDERR Dumper("IN", $s);
kkonganti@17:         $s->{ID} =~ m/ ^ (\w+) (?: \( (.*?) \) )? $ /x
kkonganti@17:           or die "Can't parse $fasta at " . Dumper($s);
kkonganti@17:         $s->{ID}  = $1 if $1;
kkonganti@17:         $s->{ACC} = $2 || $1;
kkonganti@17:         $s->{DESC} =~ s/\s\[.*?\]$//g;               # remove strain name
kkonganti@17:         $s->{DESC} =~ m/^(?:\((.*?)\)\s+)?(.*?)$/;
kkonganti@17:         $s->{ID}   = $1 if $1;
kkonganti@17:         $s->{DESC} = $2;
kkonganti@17: 
kkonganti@17:         #print STDERR Dumper("OUT", $s);
kkonganti@17:         #print STDERR "="x60, "\n";
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     #  print Dumper($seqs);
kkonganti@17:     return $seqs;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub is_full_gene {
kkonganti@17:     my ($s) = @_;
kkonganti@17:     my $has_ambig = 0;
kkonganti@17: 
kkonganti@17:     my $id = $s->{ID};
kkonganti@17:     my $L  = length( $s->{SEQ} );
kkonganti@17:     if ( $L % 3 != 0 ) {
kkonganti@17:         wrn("$id - length $L bp is not multiple of 3");
kkonganti@17:         return;
kkonganti@17:     }
kkonganti@17:     if ( $s->{SEQ} !~ m/^[AGCT]+$/ ) {
kkonganti@17:         wrn("$id - has non-AGTC bases");
kkonganti@17:         return;
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     my $seq = Bio::Seq->new( -id => $s->{ID}, -seq => $s->{SEQ} );
kkonganti@17: 
kkonganti@17:     my $aa = $seq->translate->seq;
kkonganti@17: 
kkonganti@17:     if ( $aa =~ m/\*./ ) {
kkonganti@17:         wrn("$id - has internal stop codons, trying revcom");
kkonganti@17:         $aa = $seq->revcom->translate->seq;
kkonganti@17:         if ( $aa =~ m/\*./ ) {
kkonganti@17:             wrn("$id - revcom has internal stop codons too");
kkonganti@17:             return;
kkonganti@17:         }
kkonganti@17:         else {
kkonganti@17:             msg("$id - revcom resolves problem, hooray!");
kkonganti@17:             $s->{SEQ} = $seq->revcom->seq;
kkonganti@17:         }
kkonganti@17:     }
kkonganti@17: 
kkonganti@17:     return $L;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub dedupe_seq {
kkonganti@17:     my ($seq) = @_;
kkonganti@17:     my %seen;
kkonganti@17:     my $good = [];
kkonganti@17:     for my $s (@$seq) {
kkonganti@17:         if ( $seen{ $s->{SEQ} } ) {
kkonganti@17:             wrn( "duplicate", length( $s->{SEQ} ),
kkonganti@17:                 "bp sequence:", $s->{ID}, '~', $seen{ $s->{SEQ} } );
kkonganti@17:         }
kkonganti@17:         else {
kkonganti@17:             push @$good, $s;
kkonganti@17:         }
kkonganti@17:         $seen{ $s->{SEQ} } .= ' ' . $s->{ID};
kkonganti@17:     }
kkonganti@17:     msg( "dedupe_seq: read", scalar(@$seq), "/ kept", scalar(@$good) );
kkonganti@17:     return $good;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub load_tabular {
kkonganti@17:     my ( $fname, $keycol, $sep ) = @_;
kkonganti@17:     $keycol //= 0;
kkonganti@17:     $sep    //= "\t";
kkonganti@17:     my $hash = {};
kkonganti@17:     my @hdr;
kkonganti@17:     my $row = 0;
kkonganti@17:     open my $TSV, '<', $fname or err("Can't read TSV file: $fname");
kkonganti@17:     while (<$TSV>) {
kkonganti@17:         chomp;
kkonganti@17:         my @col = split m/$sep/;
kkonganti@17:         $row++;
kkonganti@17:         if (@hdr) {
kkonganti@17:             @hdr == @col or err("Header and row $row differ in column count");
kkonganti@17: 
kkonganti@17:        #my $key = $col[$keycol] or wrn("Empty key column $keycol: $_");
kkonganti@17:        #exists{$hash->{$col[$key}} and wrn("WARNING: dupe key $key at row: $_");
kkonganti@17:             my $key = $col[$keycol];
kkonganti@17:             $hash->{$key} ||=
kkonganti@17:               { map { ( $hdr[$_] => $col[$_] ) } ( 0 .. $#hdr ) };
kkonganti@17:         }
kkonganti@17:         else {
kkonganti@17:             @hdr = @col;
kkonganti@17:         }
kkonganti@17:     }
kkonganti@17:     close $TSV;
kkonganti@17:     return $hash;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub load_fasta {
kkonganti@17:     my ($fasta) = @_;
kkonganti@17:     my %seen;
kkonganti@17:     my $list;
kkonganti@17:     my $dbtype = 'unknown';
kkonganti@17:     msg("load_fasta: $fasta");
kkonganti@17:     my $in = Bio::SeqIO->new( -file => $fasta, -format => 'fasta' );
kkonganti@17:     while ( my $seq = $in->next_seq ) {
kkonganti@17:         my $id = $seq->id or err("Empty ID in $fasta");
kkonganti@17:         if ( $seen{$id} ) {
kkonganti@17:             wrn("Duplicate ID '$id' in $fasta");
kkonganti@17:             $id = $id . '_dupe';
kkonganti@17:         }
kkonganti@17:         $seen{$id}++;
kkonganti@17:         my $s = uc( $seq->seq );
kkonganti@17:         $dbtype = $seq->alphabet eq 'dna' ? 'nucl' : 'prot';
kkonganti@17:         $dbtype eq 'nucl' ? $s =~ s/[^AGTC]/N/g : $s =~ s/[^A-Z]/X/g;
kkonganti@17:         push @$list,
kkonganti@17:           {
kkonganti@17:             ID   => $id,
kkonganti@17:             ACC  => '',
kkonganti@17:             DESC => $seq->desc,
kkonganti@17:             SEQ  => $s,
kkonganti@17:             TYPE => $dbtype,
kkonganti@17:           };
kkonganti@17:     }
kkonganti@17:     msg( "load_fasta: read", scalar(@$list), "$dbtype sequences" );
kkonganti@17:     return $list;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #..............................................................................
kkonganti@17: sub save_fasta {
kkonganti@17:     my ( $fasta, $seq ) = @_;
kkonganti@17:     msg("save_fasta: $fasta");
kkonganti@17:     my %seen;
kkonganti@17:     my $out = Bio::SeqIO->new( -file => ">$fasta", -format => 'fasta' );
kkonganti@17:     for my $s (@$seq) {
kkonganti@17:         $seen{ $s->{ID} }++;
kkonganti@17:         my $freq = $seen{ $s->{ID} };
kkonganti@17: 
kkonganti@17:         #wrn("seen $s->{ID} now $freq times") if $freq > 1;
kkonganti@17:         #    print Dumper($s);
kkonganti@17:         my $ABX =
kkonganti@17:           defined( $s->{ABX} ) ? join( $ABX_SEP, sort @{ $s->{ABX} } ) : '';
kkonganti@17:         $ABX =~ s/\s+/_/g;    # remove spaces!
kkonganti@17:         my $obj = Bio::Seq->new(
kkonganti@17:             -id   => join( '~~~', $db, $s->{ID}, $s->{ACC}, $ABX ),
kkonganti@17:             -desc => ( $s->{DESC} || $s->{ID} ),
kkonganti@17:             -seq  => $s->{SEQ},
kkonganti@17:         );
kkonganti@17: 
kkonganti@17:         #    $obj->desc( hash_encode($s) );
kkonganti@17:         $out->write_seq($obj);
kkonganti@17: 
kkonganti@17:         #    $seen{ $s->{ID} }++;
kkonganti@17:     }
kkonganti@17:     msg( "save_fasta: wrote", scalar(@$seq), "sequences" );
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #----------------------------------------------------------------------
kkonganti@17: sub msg {
kkonganti@17:     print STDERR "@_\n";
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #----------------------------------------------------------------------
kkonganti@17: sub wrn {
kkonganti@17:     msg( "WARNING:", @_ ) if $debug;
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #----------------------------------------------------------------------
kkonganti@17: sub err {
kkonganti@17:     msg( "ERROR:", @_ );
kkonganti@17:     exit(1);
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #----------------------------------------------------------------------
kkonganti@17: # Option setting routines
kkonganti@17: 
kkonganti@17: sub setOptions {
kkonganti@17:     use Getopt::Long;
kkonganti@17: 
kkonganti@17:     @Options = (
kkonganti@17:         { OPT => "help", VAR => \&usage, DESC => "This help" },
kkonganti@17:         {
kkonganti@17:             OPT     => "debug!",
kkonganti@17:             VAR     => \$debug,
kkonganti@17:             DEFAULT => 0,
kkonganti@17:             DESC    => "Verbose debug output"
kkonganti@17:         },
kkonganti@17:         {
kkonganti@17:             OPT     => "dbdir=s",
kkonganti@17:             VAR     => \$outdir,
kkonganti@17:             DEFAULT => abs_path("$FindBin::RealBin/../db"),
kkonganti@17:             DESC    => "Parent folder"
kkonganti@17:         },
kkonganti@17:         {
kkonganti@17:             OPT     => "db=s",
kkonganti@17:             VAR     => \$db,
kkonganti@17:             DEFAULT => "",
kkonganti@17:             DESC    => "Choices: $DATABASES"
kkonganti@17:         },
kkonganti@17:         {
kkonganti@17:             OPT     => "force!",
kkonganti@17:             VAR     => \$force,
kkonganti@17:             DEFAULT => 0,
kkonganti@17:             DESC    => "Force download even if exists"
kkonganti@17:         },
kkonganti@17:     );
kkonganti@17: 
kkonganti@17:     &GetOptions( map { $_->{OPT}, $_->{VAR} } @Options ) || usage(1);
kkonganti@17: 
kkonganti@17:     # Now setup default values.
kkonganti@17:     foreach (@Options) {
kkonganti@17:         if ( defined( $_->{DEFAULT} ) && !defined( ${ $_->{VAR} } ) ) {
kkonganti@17:             ${ $_->{VAR} } = $_->{DEFAULT};
kkonganti@17:         }
kkonganti@17:     }
kkonganti@17: }
kkonganti@17: 
kkonganti@17: sub usage {
kkonganti@17:     my ($exitcode) = @_;
kkonganti@17:     $exitcode = 0 if $exitcode eq 'help';  # what gets passed by getopt func ref
kkonganti@17:     $exitcode ||= 0;
kkonganti@17:     select STDERR if $exitcode;    # write to STDERR if exitcode is error
kkonganti@17: 
kkonganti@17:     print "SYNOPIS\n  Download databases for abricate to use\n";
kkonganti@17:     print "USAGE\n  $EXE [options] --db DATABASE\n";
kkonganti@17:     print "OPTIONS\n";
kkonganti@17:     foreach (@Options) {
kkonganti@17:         printf "  --%-13s %s%s.\n", $_->{OPT}, $_->{DESC},
kkonganti@17:           defined( $_->{DEFAULT} ) ? " (default '$_->{DEFAULT}')" : "";
kkonganti@17:     }
kkonganti@17:     exit($exitcode);
kkonganti@17: }
kkonganti@17: 
kkonganti@17: #----------------------------------------------------------------------
kkonganti@17: