~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/Index/Abstract.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
#
2
 
# $Id: Abstract.pm,v 1.49.4.1 2006/10/02 23:10:20 sendu Exp $
 
2
# $Id: Abstract.pm 15257 2008-12-24 05:27:05Z cjfields $
3
3
#
4
4
# BioPerl module for Bio::Index::Abstract
5
5
#
78
78
 
79
79
 
80
80
use Bio::Root::IO;
81
 
use Symbol();
 
81
use Symbol;
82
82
 
83
83
use base qw(Bio::Root::Root);
84
84
 
124
124
sub new {
125
125
    my($class, @args) = @_;
126
126
    my $self = $class->SUPER::new(@args);
127
 
    my( $filename, $write_flag, $dbm_package, $cachesize, $ffactor ) =
 
127
    my( $filename, $write_flag, $dbm_package, $cachesize, $ffactor, $pathtype ) =
128
128
        $self->_rearrange([qw(FILENAME 
129
 
                                             WRITE_FLAG
130
 
                                             DBM_PACKAGE
131
 
                                             CACHESIZE
132
 
                                             FFACTOR
 
129
                              WRITE_FLAG
 
130
                              DBM_PACKAGE
 
131
                              CACHESIZE
 
132
                              FFACTOR
 
133
                              PATHTYPE
133
134
                              )], @args);
134
135
 
135
136
    # Store any parameters passed
139
140
    $self->write_flag($write_flag)   if $write_flag;
140
141
    $self->dbm_package($dbm_package) if $dbm_package;
141
142
 
 
143
    #If user doesn't give a path, we default it to absolute
 
144
    $pathtype ? $self->pathtype($pathtype) : $self->pathtype('absolute');
 
145
 
142
146
    $self->{'_filehandle'} = []; # Array in which to cache SeqIO objects
143
147
    $self->{'_DB'}         = {}; # Gets tied to the DBM file
144
148
 
544
548
        # We're really fussy/lazy, expecting all file names to be fully qualified
545
549
        $self->throw("No files to index provided") unless @files;
546
550
        for(my $i=0;$i<scalar @files; $i++)  {
547
 
                if( $Bio::Root::IO::FILESPECLOADED && File::Spec->can('rel2abs') ) {        
548
 
                        if( ! File::Spec->file_name_is_absolute($files[$i]) ) {
 
551
                if( $Bio::Root::IO::FILESPECLOADED && File::Spec->can('rel2abs') ) {
 
552
                        if( ! File::Spec->file_name_is_absolute($files[$i])
 
553
                            && $self->pathtype() ne 'relative') {
549
554
                                $files[$i] = File::Spec->rel2abs($files[$i]);
550
555
                        }
551
556
                } else {
581
586
 
582
587
                                 # if it is the same size - fine. Otherwise die 
583
588
                                 if( -s $file == $size ) {
584
 
                                         warn "File $file already indexed. Skipping...\n" 
585
 
                                                if $self->verbose >= 0;
 
589
                                         $self->warn("File $file already indexed. Skipping..."); 
586
590
                                         next FILE;
587
591
                                 } else {
588
592
                                         $self->throw("In index, $file has changed size ($size). Indicates that the index is out of date");
590
594
                         }
591
595
 
592
596
                         # index this file
593
 
                         warn "Indexing file $file\n" if( $self->verbose > 0);
 
597
                         $self->debug("Indexing file $file\n");
594
598
 
595
599
                         # this is supplied by the subclass and does the serious work
596
600
                         $recs += $self->_index_file( $file, $i ); # Specific method for each type of index
609
613
        return ($count, $recs);
610
614
}
611
615
 
 
616
=head2 pathtype
 
617
 
 
618
  Title   : pathtype
 
619
  Usage   : $index->pathtype($pathtype)
 
620
  Function: Set the type of the file path
 
621
            Only two values are supported, 'relative' or 'absolute'.
 
622
            If the user does not give any value, it is set to
 
623
            absolute by default. Thus it mimics the default
 
624
            behavior of Bio::Index::Abstract module.
 
625
  Example : my $index = Bio::Index::Abstract->(-pathtype => 'relative',
 
626
                                               -file     => $file.inx,
 
627
                                              );
 
628
            or
 
629
            $index->pathtype('relative');
 
630
  Returns : Type of the path.
 
631
  Args    : String (relative|absolute)
 
632
 
 
633
=cut
 
634
 
 
635
sub pathtype {
 
636
 
 
637
    my($self, $type) = @_;
 
638
 
 
639
    if(defined($type)){
 
640
        if($type ne 'absolute' && $type ne 'relative'){
 
641
            $self->throw("Type of path can only be 'relative' or 'absolute', not [$type].");
 
642
        }
 
643
        $self->{'_filepathtype'} = $type;
 
644
    }   
 
645
 
 
646
    return $self->{'_filepathtype'};
 
647
}
 
648
 
 
649
 
612
650
=head2 _filename
613
651
 
614
652
  Title   : _filename
700
738
 
701
739
sub add_record {
702
740
        my( $self, $id, @rec ) = @_;
703
 
        $self->debug( "Adding key $id\n") if( $self->verbose > 0 );
 
741
        $self->debug( "Adding key $id\n");
704
742
        if( exists $self->db->{$id} ) {
705
743
                $self->warn("overwriting a current value stored for $id\n");
706
744
        }