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

View of /Clearinghouse/utils.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (download) (as text) (annotate)
Thu May 5 16:58:31 2005 UTC (14 years, 6 months ago) by disz
Branch: MAIN
Changes since 1.4: +29 -0 lines
More cleanup to services

#
# Clearinghouse utility functions.
#

use strict;
use base 'Exporter';

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

our $fig;

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
		);

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 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