view release on metacpan or  search on metacpan

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

            :                      "Directory '$ffbn_subdir' does not exist, and create_dirs not set\n";
  }
  -w $ffbn_subdir or croak "Directory '$ffbn_subdir' is not writable\n";

  systemx( 'formatdb',
           -i => $seqfile,
           -n => $new_ffbn,
           ($title ? (-t => $title) : ()),
           -l => devnull(),
           -o => $args{indexed_seqs}      ? 'T' : 'F',
           -p => $self->type eq 'protein' ? 'T' : 'F',
         );

  #now if it made an alias file, fix it up to remove the -blast-db-new
  #and the absolute paths, so that when we move it into place, it works
  if( my $aliasfile = do {
          my %exts = ( protein => '.pal', nucleotide => '.nal');
          my $n = $new_ffbn.$exts{$self->type};
          (-f $n) ? $n : undef;
      }
     ) {
    my $aliases = slurp($aliasfile);
    $aliases =~ s/-blast-db-new//g; #remove the new extension
    $aliases =~ s/$ffbn_subdir\/*//g; #remove absolute paths
    CORE::open my $a_fh, '>', $aliasfile or confess "Could not open $aliasfile for writing";
    print $a_fh $aliases;
    #closing not necessary for indirect filehandles in lexical variables
  }

  #list of files we will be replacing
  my @oldfiles = _list_files($ffbn,$self->type);

  #move the newly formatted files (almost) seamlessly into place
  foreach my $newfile ( sort (_list_files($new_ffbn,$self->type)) ) {
    my $dest = $newfile;
    $dest =~ s/-blast-db-new\./\./;

    #move it into the right place
    move( $newfile => $dest );

    #remove this file from the old files array if it's there,
    #since it has just been overwritten
    @oldfiles = grep { $_ ne $dest } @oldfiles;
  }

  #delete any old files that were not overwritten
  if(@oldfiles) {
    unlink @oldfiles;
    carp "WARNING: these files for database ".$self->full_file_basename." are no longer used and have been removed:\n",map {"-$_\n"} @oldfiles;
  }


  #and now reread our data from the new database
  $self->_read_fastacmd_info;
}


sub file_modtime {
  my $this = shift;
  my ($basename,$ext) = $this->full_file_basename;
  my $db_mtime = min( map { (stat($_))[9] } $this->list_files );
  return $db_mtime;
}




__PACKAGE__->mk_accessors('format_time');



sub check_format_permissions {
  my ($self) = @_;
  my $ffbn = $self->full_file_basename;

  my $err_str = '';

  #check the dir
  my $dir = dirname($ffbn);
  unless( $self->create_dirs ) {
    unless( -d $dir ) {
      $err_str .= "Directory '$dir' does not exist\n";
    }
    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;
}