BioPerl

 view release on metacpan or  search on metacpan

Bio/Root/IO.pm  view on Meta::CPAN

    my $root;
    for $root (@{$roots}) {
        $root =~ s#/\z##;
        (undef, undef, my $rp) = lstat $root or next;
        $rp &= 07777;   # don't forget setuid, setgid, sticky bits
        if ( -d _ ) {
            # notabene: 0777 is for making readable in the first place,
            # it's also intended to change it to writable in case we have
            # to recurse in which case we are better than rm -rf for
            # subtrees with strange permissions
            chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
              or $self->warn("Could not make directory '$root' read+writable: $!")
            unless $safe;
            if (opendir DIR, $root){
                @files = readdir DIR;
                closedir DIR;
            } else {
                $self->warn("Could not read directory '$root': $!");
                @files = ();
            }

Bio/Root/IO.pm  view on Meta::CPAN

            # is faster if done in reverse ASCIIbetical order
            @files = reverse @files if $Is_VMS;
            ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
            @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
            $count += $self->rmtree([@files],$verbose,$safe);
            if ($safe &&
              ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
                print "skipped '$root'\n" if $verbose;
                next;
            }
            chmod 0777, $root
              or $self->warn("Could not make directory '$root' writable: $!")
              if $force_writable;
            print "rmdir '$root'\n" if $verbose;
            if (rmdir $root) {
                ++$count;
            }
            else {
                $self->warn("Could not remove directory '$root': $!");
                chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
                  or $self->warn("and can't restore permissions to "
                                 . sprintf("0%o",$rp) . "\n");
            }
        }
        else {
            if (     $safe
                and ($Is_VMS ? !&VMS::Filespec::candelete($root)
                             : !(-l $root || -w $root))
                ) {
                print "skipped '$root'\n" if $verbose;
                next;
            }
            chmod 0666, $root
              or $self->warn( "Could not make file '$root' writable: $!")
              if $force_writable;
            warn "unlink '$root'\n" if $verbose;
            # delete all versions under VMS
            for (;;) {
                unless (unlink $root) {
                    $self->warn("Could not unlink file '$root': $!");
                    if ($force_writable) {
                        chmod $rp, $root
                          or $self->warn("and can't restore permissions to "
                                         . sprintf("0%o",$rp) . "\n");
                    }
                    last;
                }
                ++$count;
                last unless $Is_VMS && lstat $root;
            }
        }
    }

deobfuscator/Deobfuscator/README  view on Meta::CPAN

    ./Build test
    ./Build install

2) Copy the contents of the cgi-bin directory to your cgi-bin directory, or
any directory from which the webserver allows scripts to be executed over the
web.

3) Make sure deob_interface.cgi and deob_detail.cgi are world-executable. On a
UNIX system, the command

    chmod o+x deob_interface.cgi deob_detail.cgi

should do it.

4) Run deob_index.pl. For a default installation, run it from your
webserver's cgi-bin directory. On UNIX systems, it should be something
like:

	cd /Library/WebServer/CGI-Executables
    deob_index.pl /Library/Perl/5.8.6/Bio .

deobfuscator/Deobfuscator/bin/deob_index.pl  view on Meta::CPAN

    printf STDOUT "%5d %s\n", $stats{$stat}, $stat;
    printf $log "%5d %s\n", $stats{$stat}, $stat;
}

# close files and DBs
untie $meth_db or die "deob_index.pl: couldn't close $meth_file: $!\n";
untie $pkg_db  or die "deob_index.pl: couldn't close $pkg_file: $!\n";
close $list    or die "deob_index.pl: couldn't close $list: $!\n";
close $log     or die "deob_index.pl: couldn't close $log: $!\n";
my $mode = 0666;
chmod($mode, $pkg_file, $meth_file, $list_file);

### Parsing subroutines ###
sub extract_pod {
    my ($file) = $_;
    my $long_file = $File::Find::name;

    # skip if it's on our exclude list
    foreach my $one (keys %exclude) {
        if ($File::Find::name =~ /$one$/) {
            print STDERR "Excluding $file\n";

t/RemoteDB/GenBank.t  view on Meta::CPAN

    while ($seq = $seqin->next_seq) {
        is $seq->length, shift(@result);
        is $seq->alphabet, shift(@result);
    }
    is @result, 0;
    # Real batch retrieval using epost/efetch
    # these tests may change if integrated further into Bio::DB::Gen*
    # Currently only useful for retrieving GI's via get_seq_stream
    $gb = Bio::DB::GenBank->new();
    eval {$seqin = $gb->get_seq_stream(-uids => [4887706 ,431229, 147460], -mode => 'batch');};
    skip "Couldn't connect to complete GenBank batchmode epost/efetch tests. Skipping those tests", 8 if $@;
    my %result = ('M59757' => 12611 ,'X76083'=> 3140, 'J01670'=> 1593);
	my $ct = 0;
    while ($seq = $seqin->next_seq) {
		$ct++;
		my $acc = $seq->accession;
        ok exists $result{ $acc };
        is $seq->length, $result{ $acc };
		delete $result{$acc};
    }
    skip('No seqs returned', 8) if !$ct;

t/Root/IO.t  view on Meta::CPAN

#############################################

ok my $io = Bio::Root::IO->new();

# An executable file
my $out_file = 'test_file.txt';
my $out_fh;
open  $out_fh, '>', $out_file or die "Could not write file '$out_file': $!\n";
print $out_fh 'test';
close $out_fh;
# -X test file will fail in Windows regardless of chmod,
# because it looks for the executable suffix (like ".exe")
if ($^O =~ m/mswin/i) {
    # An executable file
    my $exec_file = 'test_exec.exe';
    open my $exe_fh, '>', $exec_file or die "Could not write file '$exec_file': $!\n";
    close $exe_fh;
    ok $obj->exists_exe($exec_file), 'executable file';
    unlink $exec_file or die "Could not delete file '$exec_file': $!\n";

    # A not executable file
    ok (! $obj->exists_exe($out_file), 'non-executable file');
    unlink $out_file  or die "Could not delete file '$out_file': $!\n";
}
else {
    # An executable file
    chmod 0777, $out_file or die "Could not change permission of file '$out_file': $!\n";
    ok $obj->exists_exe($out_file), 'executable file';

    # A not executable file
    chmod 0444, $out_file or die "Could not change permission of file '$out_file': $!\n";
    ok (! $obj->exists_exe($out_file), 'non-executable file');
    unlink $out_file or die "Could not delete file '$out_file': $!\n";
}

# An executable dir
my $out_dir = 'test_dir';
mkdir $out_dir or die "Could not write dir '$out_dir': $!\n";
chmod 0777, $out_dir or die "Could not change permission of dir '$out_dir': $!\n";
ok (! $obj->exists_exe($out_dir), 'executable dir');
rmdir $out_dir or die "Could not delete dir '$out_dir': $!\n";


#############################################
# tests for handle read and write abilities
#############################################

# Test catfile