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

View of /Clearinghouse/utils.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (download) (as text) (annotate)
Tue May 3 20:18:57 2005 UTC (14 years, 6 months ago) by olson
Branch: MAIN
Changes since 1.2: +62 -0 lines
Add validation on subsystems.

Move validation code into utils::validate_package($package_file, $package_type).

#
# 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
		 get_lock
		 release_lock
		 get_page_header
		 validate_package
		);

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



1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3