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

View of /FigKernelScripts/aclh.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (download) (as text) (annotate)
Mon Feb 4 20:20:19 2008 UTC (12 years ago) by paarmann
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, 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, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.10: +1 -1 lines
added new parameter to dump contribs

########################################################################
# -*- perl -*-
#
# 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.
#

use Carp;
use Data::Dumper;
use strict;

use FIG;
my $fig = new FIG;

use AnnoClearinghouse;

# usage: aclh directory contrib--dir

my $echo       = 0;
my $time_cmds  = 0;
while ((@ARGV > 0) && ($ARGV[0] =~ /^-/))
{
    my $arg = shift @ARGV;
    if ($arg =~ /^-time/i) { $time_cmds = 1 }
    if ($arg =~ /^-echo/i) { $echo      = 1 }
}

my $default_dir;
my $contrib_dir;

@ARGV == 2 or die "Usage: $0 clearinghouse-dir contrib-dir\n";

$default_dir = shift;
$contrib_dir = shift;

my $aclh = new AnnoClearinghouse($default_dir, $contrib_dir);

while (my $req = &get_req)
{
    if ($req =~ /^\s*id\s+(\S+)/)
    {
	my $id = $1;
	my $block = $aclh->lookup_id($id);

	if (!$block)
	{
	    print "Nothing found for $id\n";
	    next;
	}
	for my $ent (@$block)
	{
	    my($eid, $len) = @$ent;
	    my $fn = $aclh->get_assignment($eid);
	    my $org = $aclh->get_org($eid);
	    $org = "(no org)" unless $org;
	    print join("\t", $eid, $len, $org, $fn), "\n";
	}

    }
    elsif ($req =~ /^\s*pid\s+(\S+)/)
    {
	my $id = $1;
	my $block = $aclh->expand_block($id);

	if (!$block)
	{
	    print "Nothing found for $id\n";
	    next;
	}
	for my $ent (@$block)
	{
	    my($eid, $len) = @$ent;
	    my $fn = $aclh->get_assignment($eid);
	    my $org = $aclh->get_org($eid);
	    $org = "(no org)" unless $org;
	    print join("\t", $eid, $len, $org, $fn), "\n";
	}

    }
    elsif ($req =~ /^\s*search\s+((\d+)\s+)?(.*)\s*$/)
    {
	my @res = $aclh->search($3, $2);

	for my $ent (@res)
	{
	    print join("\t", @$ent), "\n";
	}
    }
    elsif ($req =~ /^\s*seq\s+(\S+)/)
    {
	my $id = $1;
	my $seq = $aclh->get_sequence($id);

	if (!$seq)
	{
	    print "Nothing found for $id\n";
	    next;
	}
	&FIG::display_id_and_seq($id, \$seq, \*STDOUT);
    }
    elsif ($req =~ /^\s*purge_user\s+(\S+)/)
    {
	my $user = $1;
	my $n = $aclh->purge_user_annotations($user);
	print "Purged $n annotations by $user\n";
    }
    elsif ($req =~ /^\s*get_user\s+(\S+)/)
    {
	my $user = $1;
	my @out = $aclh->get_all_user_annotations($user);
	map { print "$_->[0]\t$_->[1]\n"; } @out;
    }
    elsif ($req =~ /^\s*dir\s+(\S+)/)
    {
	my $dir = $1;
	if (! -d $dir)
	{
	    print "Directory $dir does not exist\n";
	    next;
	}
	my $new_aclh = new AnnoClearinghouse($dir);
	if (!$new_aclh)
	{
	    print "Error creating clearing house object for $dir\n";
	    next;
	}
	$aclh = $new_aclh;
    }
    elsif ($req =~ /^\s*check_file\s+(\S+)/)
    {
	my $file = $1;

	if (!open(F, "<$file"))
	{
	    print "Cannot open $file: $!\n";
	    next;
	}

	while (<F>)
	{
	    if (/^(\S+)/)
	    {
		my $id = $1;
		my $prin_id = $aclh->lookup_principal_id($1);
		print "$id\t$prin_id\n";
	    }	    
	}
	    
    }
    elsif ($req =~ /^\s*check_id\s+(\S+)/)
    {
	my $id = $1;

	my @list = $aclh->lookup_principal_id($1);
	for my $ent (@list)
	{
	    my($mapped, $prin) = @$ent;
	    print "$mapped\t$prin\n";
	}
    }
    elsif ($req =~ /^\s*import\s+(\S+)\s+(\S+)/)
    {
	my $user = $1;
	my $file = $2;

	my @bad;
	my $count = $aclh->import_user_annotations($user, $file, \@bad);
	print "Imported $count annotations\n";
	if (@bad)
	{
	    my $n = @bad;
	    print "$n ids did not map:\n";
	    for my $ent (@bad)
	    {
		my($id, $line, $msg) = @$ent;
		print "$file line $line:\t$id\t$msg\n";
	    }
	}
    }
    elsif ($req =~ /^count contrib$/) 
    {
      my $count = $aclh->count_contrib_annotations();
      print "Total number of contributed annotations: $count\n";
    }
    elsif ($req =~ /^count contrib unique$/) 
    {
      my $count = $aclh->count_contrib_unique_annotations();
      print "Total number of unique annotations contributed by users: $count\n";
    }
    elsif ($req =~ /^\s*export contrib\s+(\S+)/)
    {

      my $file = $1;      
      if (!open(F, ">$file")) {
	print "Cannot open $file: $!\n";
	next;
      }
      
      print F $aclh->dump_contrib_annotations(1,1);
      close (F);
      print "Done.\n";
      
    }
    elsif ($req =~ /^\s*h\s*$/ || $req =~ /^\s*help\s*$/)
    {
     &help;
    }
    else
    {
	print "invalid command\n";
    }
    print "\n";
}

sub get_req {
    my($x);

    print "?? ";
    $x = <STDIN>;
    while (defined($x) && ($x =~ /^h$/i) )
    { 
	&help;
	print "?? ";
	$x = <STDIN>;
    }
    
    if ((! defined($x)) || ($x =~ /^\s*[qQxX]/))
    {
	return "";
    }
    else
    {
        if ($echo)
	{
	    print ">> $x\n";
	}
	return $x;
    }
}


sub help {
    print <<END;
    
    h
    id				     identifier
    search			     keyword
    purge_user 			     username (retrieve user annotations)
    get_user 			     username (purge user annotations)
    check_file                       filename (check ids)
    check_id                         id (check one ID; print list of mapped ids)
    import                           username filename (import user annotations)
    count                            contrib (print total count of contributed annotations)
    count                            contrib unique (print count of contributed unique annotations)
    export                           contrib filename (dump user contributions to filename)
                   
END
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3