[Bio] / Clearinghouse / utils.pm Repository:
ViewVC logotype

View of /Clearinghouse/utils.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (download) (as text) (annotate)
Wed Jan 11 21:19:21 2006 UTC (13 years, 10 months ago) by olson
Branch: MAIN
Changes since 1.6: +16 -0 lines
Collected clearinghouse updates.

#
# Clearinghouse utility functions.
#

use strict;
use base 'Exporter';

use IO::Handle;
use IPC::Open3;
use FileHandle;
use HTML;
use Clearinghouse::ch_database;
use FIG;
use FIG_Config;

our $fig;
our $log_fh;

our @EXPORT = qw(check_types
		 lock_init
		 type_init
		 get_lock
		 release_lock
		 get_page_header
		 validate_package
		 make_accession
		 insert_ch_record
		 insert_meta_data
		 insert_package_location
		 check_for_duplicates
		 log
		);

sub ch_log
{
    my($str) = @_;
    if (not defined($log_fh))
    {
	&FIG::verify_dir("$FIG_Config::fig/var");
	$log_fh = new FileHandle  ">>$FIG_Config::fig/var/clearinghouse.log";
	$log_fh->autoflush(1);
    }

    print $log_fh $str;
}

sub validate_package
{
    my($pkg, $type) = @_;

    my %meta;

    my $stdin = new IO::Handle;
    my $stdout = new IO::Handle;
    my $stderr = new IO::Handle;

    my $cmd;

    if ($type eq "SUBSYSTEM" or $type eq "1-SUBSYSTEM")
    {
	$cmd = "$FIG_Config::bin/validate_subsystem";
    }
    elsif ($type eq "GENOME")
    {
	$cmd = "$FIG_Config::bin/validate_genome_gff";
    }
    else
    {
	die "validate_package: invalid type $type\n";
    }

    my $pid = open3($stdin, $stdout, $stderr, "$cmd $pkg");

    $pid or die "Cannot run $cmd $pkg: $!";

    close($stdin);

    my @out = <$stdout>;

    my @err = <$stderr>;

    close($stdout);
    close($stderr);

    waitpid($pid, 0);

    if ($?)
    {
	die "Validate failed with exit code $?. Error output:\n@out\n";
    }

    foreach $_ (@out)
    {
	chomp;
	my($k, $v) = split(/\t/);
	$meta{$k} = $v;
    }

    return %meta;
}

sub get_page_header
{
    my @page_header = &HTML::compute_html_header(undef, undef,
						 header_name => 'clearinghouse.hdr',
						 tail_name => 'clearinghouse.tail',
						 no_fig_search => 1,
						 no_release_info => 1);
    return join("\n", @page_header);
}

sub check_types {
	my ($type) = @_;
	my $db = db_init();

	my $ar = $db->SQL(qq(SELECT type FROM types WHERE type = '$type'));
	return @$ar; #length = 0, if no rows
}

sub check_for_duplicates {
	my ($type, $meta_data) = @_;
	my $db = db_init();
	if ($type eq 'GENOME') {
		return check_for_duplicate_genome($meta_data);
	} elsif ($type eq 'SUBSYSTEM') {
		return check_for_duplicate_subsystem($meta_data);
	} else {
		return 1;
	}
}

sub check_for_duplicate_genome {
	my ($meta_data) = @_;
	my $genome_id;


	my @md = split (/\n/, $meta_data);
	for my $i (@md) {
		my ($tag, $value) = split(/\t/, $i);
		if ($tag eq 'genome_id') {
			$genome_id = $value;
			last;
		}
	}

	my $db = db_init();
	my $ar = $db->SQL(qq(SELECT ch_id FROM meta_data WHERE tag = 'genome_id' AND value = '$genome_id'));
	return @$ar; #length = 0, if no rows
}

sub check_for_duplicate_subsystem {
	my ($meta_data) = @_;
	my ($name, $version);
	my @md = split (/\n/, $meta_data);
	for my $i (@md) {
		my ($tag, $value) = split(/\t/, $i);
		if ($tag eq 'name') {
			$name = $value;
		}
		if ($tag eq 'version') {
			$version = $value;
		}
	}
	my $db = db_init();

	print STDERR "NAME $name, VERSION $version\n";
	my $ar = $db->SQL(qq(SELECT c.id FROM meta_data m1, meta_data m2, clearing_house c 		WHERE (c.id = m1.ch_id AND c.id = m2.ch_id AND
		m1.tag = 'name' and m1.value = '$name' AND 
		m2.tag = 'version' and m2.value = '$version' AND
		c.type = 'SUBSYSTEM')));

	return @$ar; #length = 0, if no rows
}



sub lock_init {
    my ($dbh) = @_; 
    
    my $sth = $dbh->{_dbh}->prepare(q(INSERT into locks (name, lock)
                                      VALUES (?, ?)
                                     )) or die $dbh->{_dbh}->errstr;
    $sth->execute("genome", 0);
    $sth->execute("feature", 0);
}

sub type_init {
    my ($dbh) = @_;
   
    my $sth = $dbh->{_dbh}->prepare(q(INSERT into types (type)
                                      VALUES (?)
                                     )) or die $dbh->{_dbh}->errstr;

    # Initialize the known set of types.
    #

    $sth->execute("GENOME");
    $sth->execute("ANNOTATION");
    $sth->execute("SUBSYSTEM");
    $sth->execute("1-SUBSYSTEM");
    $sth->execute("SIMS");
    $sth->execute("FEATURE");
}


sub get_lock {
    my ($dbh, $name, $timeout) = @_;
    
    my $sth = $dbh->prepare(q{UPDATE locks  set lock = 1 where name = ? and lock = 0}) or die $dbh->errstr;
    my $res = $sth->execute($name);
    while  ($sth->rows == 0) {
	if ($timeout-- == 0) {
	    die "Lock timout";
	}
	sleep 1;
	my $res = $sth->execute($name);
    }
}


sub release_lock {
    my ($dbh, $name) = @_;
    
    my $sth = $dbh->prepare(q{UPDATE locks  set lock = 0 where name = ?}) or die $dbh->errstr;
    $sth->execute($name);
}


sub make_accession {
	my ($db, $who, $source) = @_;
	my $dbh = $db->{_dbh};
	my $timestamp = time();
	my $accession_id;

	my $sth = $dbh->prepare(q{INSERT into accession (who, accession_date, comments, source) VALUES (?, ?,?,?)}) or die $dbh->errstr;
	$sth->execute($who, $timestamp, '', $source) or die $dbh->errstr;
	#check the result here. check what execute returne wrt errors
	my $accession_id = $db->get_inserted_id('accession', $sth);
	return $accession_id;
}

sub insert_ch_record {
	my ($db, $accession_id, $type, $meta_data, $description) = @_;
        my $dbh = $db->{_dbh};
	my $sth = $dbh->prepare(q{INSERT into clearing_house (accession_id, type, meta_data, description) VALUES (?,?,?,?) }) or die $dbh->errstr;
	$sth->execute($accession_id, $type, $meta_data, $description);
	my $ch_id = $db->get_inserted_id('clearing_house', $sth);
	return $ch_id;
}


sub insert_meta_data {
	my ($dbh, $ch_id, $meta_data) = @_;

	my $sth = $dbh->prepare(q{INSERT into meta_data (ch_id, tag, value) VALUES (?, ?,?)}) or die $dbh->errstr;
	my @md = split (/\n/, $meta_data);
	for my $i (@md) {
		my ($tag, $value) = split(/\t/, $i);
		$sth->execute($ch_id, $tag, $value);
	}
}

sub insert_package_location {
	my ($dbh, $ch_id, $path) = @_;
	my $sth = $dbh->prepare(q{INSERT into package_location (ch_id, pathname) VALUES (?,?)}) or die $dbh->errstr;
	$sth->execute($ch_id, $path);

}



1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3