[Bio] / FigKernelScripts / renumber_seed_dir.pl Repository:
ViewVC logotype

View of /FigKernelScripts/renumber_seed_dir.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (as text) (annotate)
Wed Apr 28 22:12:25 2010 UTC (9 years, 9 months ago) by olson
Branch: MAIN
CVS Tags: mgrast_dev_08112011, mgrast_dev_08022011, myrast_rel40, mgrast_dev_05262011, mgrast_dev_04082011, rast_rel_2010_0928, mgrast_version_3_2, mgrast_dev_12152011, mgrast_dev_06072011, rast_rel_2010_0526, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2011_0119, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, mgrast_dev_04012011, rast_rel_2010_0827, myrast_33, rast_rel_2011_0928, mgrast_dev_04052011, mgrast_dev_02222011, mgrast_dev_10262011
Changes since 1.3: +11 -7 lines
Don't fail if Features dir does not exist.

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#

#
# Rename the genome from whatever it is in the given SEED skeleton dir to
# the genome ID passed on the command line. Used to regenerate the genome dir
# after registering the taxon id with the clearinghouse.
#

use strict;
use File::Copy;
use Getopt::Long;


my $usage = "Usage: renumber_seed_dir [--exists-ok] old-dir new-genome-id new-dir";

my $exists_ok;
my $rc = GetOptions("exists-ok" => \$exists_ok);

($rc && @ARGV == 3) or die $usage;

my($old_dir, $new_id, $new_dir) = @ARGV;

-d $old_dir or die "Old dir $old_dir not found\n";
if (-d $new_dir && !$exists_ok)
{
    die "New directory $new_dir must not exist\n";
}

$new_id =~ /^\d+\.\d+/ or die "Invalid genome id $new_id\n";

#
# Make directories first.
#
-d $new_dir or mkdir($new_dir) or die "Cannot mkdir $new_dir $!";

my @feature_types;
if (opendir(D, "$old_dir/Features"))
{
    mkdir "$new_dir/Features" or die "mkdir $new_dir/Features failed: $!";
    
    @feature_types = grep { $_ !~ /^\./ and -d "$old_dir/Features/$_" } readdir(D);
    closedir(D);
    
    for my $ft (@feature_types)
    {
	mkdir("$new_dir/Features/$ft") or die "Cannot mkdir $new_dir/Features/$ft: $!";
    }
}

#
# Copy the plain files over.
#

opendir(D, $old_dir) or die "Cannot open dir $old_dir: $!";

my @top_files = grep { $_ !~ /^\./ and -f "$old_dir/$_" } readdir(D);
closedir(D);

for my $file (@top_files)
{
    #
    # original code only did this for some; is there any reason we should not replace all?
    #
    copy_and_replace("$old_dir/$file", "$new_dir/$file") or die "copy $file failed: $!";
}

#
# Handle the features.
#

for my $ft (@feature_types)
{
    my $ofd = "$old_dir/Features/$ft";
    my $nfd = "$new_dir/Features/$ft";

    copy_and_replace("$ofd/fasta", "$nfd/fasta");
    copy_and_replace("$ofd/tbl", "$nfd/tbl");
}

sub copy_and_replace
{
    my($old, $new, $col) = @_;

    open(O, "<$old") or die "Cannot open $old: $!";
    open(N, ">$new") or die "Cannot open $new: $!";

    while (<O>)
    {
	s/fig\|\d+(\.\d+)?\.(\w+)/fig|$new_id.$2/g;
	print N $_;
    }
    close(O);
    close(N);
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3