Bio-Grep

 view release on metacpan or  search on metacpan

lib/Bio/Grep/Backend/Agrep.pm  view on Meta::CPAN

    }

    my $filename = $args{filename};

    open my $DATFILE, '>', "$filename.dat";
    open my $MAPFILE, '>', "$filename.map";
    my $in = Bio::SeqIO->new( -file => $filename, -format => $args{format} );
    my $id = 1;
    while ( my $seq = $in->next_seq() ) {
        print ${MAPFILE} $seq->id . "\n"
            or $self->_cannot_print("$filename.dat");
        print ${DATFILE} $id . q{:} . $seq->seq . "\n"
            or $self->_cannot_print("$filename.map");
        $id++;
    }
    close $DATFILE;
    close $MAPFILE;
    $self->_create_index_and_alphabet_file($filename);
    return 1;
}

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

lib/Bio/Grep/Backend/BackendI.pm  view on Meta::CPAN

        my $abs_path = $self->is_path( abs_path( $args->{file} ) );
        symlink $abs_path, $newfile || $self->throw(
            -class => 'Bio::Root::IOException',
            -text  => q{Can't symlink } . $abs_path . " to $newfile",
            -value => $OS_ERROR,
        );
    }
    if ( defined $args->{description} ) {
        open my $NFOFILE, '>', $newfile . '.nfo';
        print ${NFOFILE} $args->{description}
            or $self->_cannot_print("$newfile.nfo");
        close $NFOFILE;
    }
    return;
}

sub _guess_alphabet_of_file {
    my ( $self, $filename ) = @_;
    my $in = Bio::SeqIO->new( -file => $filename );
    return $in->next_seq->alphabet;
}

lib/Bio/Grep/Backend/BackendI.pm  view on Meta::CPAN

            -class => 'Bio::Root::BadParameter',
            -text  => 'Back-end does not support protein data',
            -value => $alphabet,
        );
    }

    # create a vmatch alphabet file
    open my $ALFILE, '>', "$filename.al1";
    if ( $alphabet eq 'dna' ) {
        print ${ALFILE} "aA\ncC\ngG\ntTuU\nnsywrkvbdhmNSYWRKVBDHM\n"
            or $self->_cannot_print("$filename.al1");
    }
    else {
        print ${ALFILE}
            "L\nV\nI\nF\nK\nR\nE\nD\nA\nG\nS\nT\nN\nQ\nY\nW\nP\nH\nM\nC\nXUBZ*\n"
            or $self->_cannot_print("$filename.al1");
    }
    close $ALFILE;

    # create database from directory of fasta files
    my $idx = Bio::Index::Fasta->new(
        -filename   => $filename . '.idx',
        -write_flag => 1
    );
    $idx->make_index( ($filename) );

lib/Bio/Grep/Backend/Vmatch.pm  view on Meta::CPAN

    my ( $tmp_fh, $tmpfile );

    my $seq_query = q{};

    if ( @{$seqid}[0] =~ m{\A \d+ \z}xms ) {
        ( $tmp_fh, $tmpfile )
            = tempfile( 'vseqselect_XXXXXXXXXXXXX', DIR => $s->tmppath );

        for my $sid ( @{$seqid} ) {
            print ${tmp_fh} $sid . " \n "
                or $self->_cannot_print($tmpfile);
        }
        close $tmp_fh;
        $seq_query = ' -seqnum ' . $tmpfile;
    }
    else {
        my $seq_desc = $self->is_sentence( @{$seqid}[0] );
        $seq_query = ' -matchdesc "' . $seq_desc . q{"};
    }

    my $command

lib/Bio/Grep/Root.pm  view on Meta::CPAN

    if ( !defined $value ) {
        $self->throw(
            -class => 'Bio::Root::BadParameter',
            -text  => $args{desc} . ' looks not valid.',
            -value => $args{variable}
        );
    }
    return $value;
}

sub _cannot_print {
    my ( $self, $filename ) = @_;
    $self->throw(
        -class => 'Bio::Root::IOException',
        -text  => 'Cannot write to file',
        -value => $filename
    );
    return;
}

1;    # Magic true value required at end of module

t/40.utils.t  view on Meta::CPAN

is( $sbe->_cat_path_filename( $paths[0], 't.txt' ), 't.txt', 'concat path' );

my $tainted_word    = 'bla' . substr( cwd, 0, 0 );
my $tainted_integer = '1' . substr( cwd,   0, 0 );
my $tainted_real    = '1.1' . substr( cwd, 0, 0 );

ok( tainted $tainted_word,    $tainted_word . ' tainted' );
ok( tainted $tainted_integer, $tainted_integer . ' tainted' );
ok( tainted $tainted_real,    $tainted_real . ' tainted' );

my $not_tainted_integer = $sbe->is_integer($tainted_integer);
ok( !tainted $not_tainted_integer, $not_tainted_integer . ' not tainted' );
my $not_tainted_word = $sbe->is_word($tainted_word);
ok( !tainted $not_tainted_word, $not_tainted_word . ' not tainted' );

is( $sbe->is_integer('1234'), 1234 );
eval { $sbe->is_integer('1234.5'); };
ok($EVAL_ERROR);
eval { $sbe->is_integer('10 && ls *'); };
ok($EVAL_ERROR);
is( $sbe->is_integer(undef), undef );


is( $sbe->is_word('1234'),           1234 );