Issue #238 | fix Database report

tseemann · Oct 13, 2019 · 5e11d97 · 5e11d97
1 parent c384d9a
commit 5e11d97
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 18 deletions.
diff --git a/bin/nullarbor-report.pl b/bin/nullarbor-report.pl
@@ -25,7 +25,7 @@
 
 my $EXE = "$FindBin::RealScript";
 my $TEMPLATE_DIR = "$FindBin::RealBin/../conf";
-my $VERSION = '2.0.20191007';
+my $VERSION = '2.0.20191013';
 my $AUTHOR = 'Torsten Seemann';
 my @CMDLINE = ($0, @ARGV);
 

diff --git a/bin/nullarbor.pl b/bin/nullarbor.pl
@@ -30,7 +30,7 @@
 # constants
 
 my $EXE = "$FindBin::RealScript";
-my $VERSION = '2.0.20191007';
+my $VERSION = '2.0.20191013';
 my $AUTHOR = 'Torsten Seemann';
 my $URL = "https://github.com/tseemann/nullarbor";
 my @CMDLINE = ($0, @ARGV);
@@ -467,7 +467,7 @@ sub check_deps {
   my($self) = @_;
 
   require_perlmod( qw'Bio::SeqIO Cwd Sys::Hostname Time::Piece List::Util YAML::Tiny' );
-  require_perlmod( qw'Moo Path::Tiny File::Copy File::Spec File::Path Data::Dumper' );
+  require_perlmod( qw'Moo Path::Tiny File::Copy File::Which File::Basename File::Spec File::Path Data::Dumper' );
   require_perlmod( qw'Term::ANSIColor SVG Text::CSV List::MoreUtils IO::File' );
 
   require_exe( qw'head cat install env nl grep touch tr' );

diff --git a/perl5/Nullarbor/Module/databases.pm b/perl5/Nullarbor/Module/databases.pm
@@ -3,6 +3,8 @@ use Moo;
 extends 'Nullarbor::Module';
 
 use File::stat;
+use File::Which;
+use File::Basename;
 use Cwd qw(realpath);
 use Nullarbor::Logger qw(msg err);
 use Time::Piece;
@@ -15,9 +17,21 @@ sub name {
 
 #...........................................................................................
 
-sub file_date {
+sub get_makefile_var {
+  my($self, $var) = @_;
+  open my $MF, '<', $self->indir . '/Makefile';
+  my($line) = grep { m/^$var\b/ } <$MF>;
+  close $MF;
+  chomp $line;
+  $line =~ s/^.*?\s*:=\s*//g;
+  return $line;
+}
+
+#...........................................................................................
+
+sub _file_date {
   my($fname) = @_;
-  my $s = stat($fname);
+  my $s = stat($fname) or return 'not available';;
   my $t = localtime($s->mtime);
   return $t->ymd;
 }
@@ -30,21 +44,27 @@ sub html {
 
   my @inv = ( [ "Database", "Name", "Date" ] );
 
-  # Kraken
-  my $db = $ENV{KRAKEN_DEFAULT_DB};
-  -d $db or err("Can't read Kraken database folder '$db'");
-  $db = realpath($db);
-  push @inv, [ 'Kraken', $db, file_date("$db/database.kdb") ];
-
-  # mlst
-  my($m) = qx(mlst --help | grep -- --blastdb);
-  $m =~ m/default\s+'(.*?)'/ or err("Could not parse: $m");
-  $db = realpath($1);
-  push @inv, [ 'mlst', $db, file_date($db) ];
+  # the fact that I need to hack this out of the Makefile
+  # embarrases me; but not enough to make me refactor the
+  # whole pipeline. well not yet, anyway.
+
+  my $tax = $self->get_makefile_var('TAXONER');
+  ($tax) = $tax =~ m{/(\w+)\.sh$};
+  my $taxdb = $ENV{ uc($tax)."_DEFAULT_DB" };
+  push @inv, [ "Taxoner($tax)", $taxdb, _file_date($taxdb) ];
+
+  my $abrdb = realpath(dirname(which('abricate'))."/../db");
 
-  # resistome
+  my $res = $self->get_makefile_var('RESISTOME_DB');
+  my $resfn = "$abrdb/$res/sequences";
+  push @inv, [ 'Resistome', $resfn, _file_date($resfn) ];
 
-  # virulome
+  my $vir = $self->get_makefile_var('VIRULOME_DB');
+  my $virfn = "$abrdb/$vir/sequences";
+  push @inv, [ 'Virulome', $virfn, _file_date($virfn) ];
+
+  my $mlst = realpath(dirname(which('mlst'))."/../db/blast/mlst.fa");
+  push @inv, [ 'MLST', $mlst, _file_date($mlst) ];
 
   return $self->matrix_to_html(\@inv, 1);
 }