view release on metacpan or  search on metacpan

lib/Bio/BLAST/Database.pm  view on Meta::CPAN

    }
    elsif( ! -w $dir ) {
      $err_str .= "Directory $dir exists, but is not writable\n";
    }
  } else {
    my @dirs = splitdir($dir);
    #use Data::Dumper;
    #die Dumper \@dirs;
    pop @dirs while @dirs && ! -d catdir(@dirs);
    my $d = catdir(@dirs);
    if( ! @dirs ) {
      $err_str .= "Entire directory tree for '$dir' does not exist!\n";
    }
    elsif(! -w $d ) {
      $err_str .= "Directory $d is not writable, cannot make dirs\n";
    }
  }


  #check writability of any  files that are already there
  my @files = $self->list_files();
  foreach (@files) {
    if( -f && !-w ) {
      $err_str .= "Blast DB component file $_ exists, but is not overwritable\n";
    }
  }
  return $err_str if $err_str;
  return;
}


sub is_split {
  my ($self) = @_;
  my $ffbn = $self->full_file_basename;
  return 1 if grep /^$ffbn\.\d{2,3}\.[np]\w\w$/,$self->list_files;
  return 0;
}


sub files_are_complete {
  my ($self) = @_;

  #list of files belonging to this db
  my @files = $self->list_files;

  #certainly not complete if fewer than 3 files
  return 0 unless @files >= 3;

  #assemble list of necessary extensions
  my @necessary_extensions = (qw/sq hr in/, #base database files
			      #add seqid indexes if called for
			      $self->indexed_seqs ? qw/sd si/ : (),
			     );

  #add protein/nucleotide prefix to extensions
  my $norp = $self->type eq 'protein' ? '.p' : '.n';
  $_ = $norp.$_ foreach @necessary_extensions;

  #deal with large, split databases
  if( $self->is_split ) {
    #if the database is split, add all of the fragment numbers to
    #the extensions we have to have

    #maximum index number of all fragments present
    my $max_frag_num = 0 + max( map { /\.(\d{2,3})\.[np]\w\w$/ ? $1 : 0 } @files);

    #make extensions with all of the necessary fragment numbers
    @necessary_extensions = map { my $ext = $_;
				  map {sprintf(".%02d$ext",$_)} (0..$max_frag_num)
				} @necessary_extensions;

    #also remember that we have to have an alias file for split dbs
    push @necessary_extensions, $norp.'al';
  }

  #now that we have our list of all the file extensions we need to have,
  #check if they are actually there
  my $ffbn = $self->full_file_basename;
  return all {
	       my $ext = $_;
	       (grep {$_ eq "$ffbn$ext"} @files) ? 1 : 0
	     } @necessary_extensions;
}


sub list_files {
  my $self = shift;
  croak "cannot list files without knowing the database type" unless $self->type;
  _list_files($self->full_file_basename, $self->type);
}
#our internal version of this function just takes a full file basename,
#and a db type, and returns all the files that go with that database
sub _list_files {
  my ($ffbn,$type) = @_;

  #file extensions for each type of blast database
  my %valid_extensions = ( protein     => [qw/.psq .phr .pin .psd .psi .pal .pnd .pni/],
			   nucleotide  => [qw/.nsq .nhr .nin .nsd .nsi .nal .nnd .nni/],
			 );

  #file extensions for _this_ database
  $valid_extensions{$type} or confess 'invalid type '.$type;
  my @search_extensions = @{$valid_extensions{$type}};

  #this gives us all files which have our basename, and one of the right search extensions
  my @myfiles =
    grep {
      my $file = $_;
      grep {$file =~ /^$ffbn(\.\d{2})?$_$/} @search_extensions
    } glob("$ffbn*");

  for (@myfiles) { -f or confess 'sanity check failed' };

  return @myfiles;
}


__PACKAGE__->mk_accessors('sequences_count');



sub get_sequence {
    my ($self, $seqname) = @_;

    croak "cannot call get_sequence on an incomplete database!"
        unless $self->files_are_complete;

    croak "cannot call get_sequence on a database that has not been indexed for retrieval!"
        unless $self->indexed_seqs;