[Bio] / FortyEight / SGE.pm Repository:
ViewVC logotype

View of /FortyEight/SGE.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (as text) (annotate)
Wed Sep 5 21:42:54 2007 UTC (12 years, 7 months ago) by olson
Branch: MAIN
CVS Tags: rast_rel_2008_06_18, rast_rel_2008_06_16, rast_rel_2008_07_21, rast_2008_0924, rast_rel_2008_04_23, rast_rel_2008_09_30, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, mgrast_rel_2008_0625, rast_rel_2008_10_09, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, mgrast_rel_2008_1110, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, rast_rel_2008_08_07
new files

package SGE;

use XML::LibXML;
use strict;
use Data::Dumper;

#
# Utilities for dealing with a SGE-enabled cluster.
#

sub new
{
    my($class) = @_;

    my $self = {
	jobs => {},
    };

    bless $self, $class;

    $self->read_qstat();

    return $self;
}

sub read_qstat
{
    my($self) = @_;
    if (!open(Q, "qstat  -f -s prsz -xml |"))
    {
	warn "Could not read queue status: $!\n";
	return;
    }

    my $parser = XML::LibXML->new();
    my $doc = $parser->parse_fh(\*Q);

    close(Q);
    if (!$doc)
    {
	die "Cannot parse qstat output\n";
    }

    #
    # Walk the joblists and populate $self->{jobs} with information about them.
    #

    for my $node ($doc->findnodes('//job_list'))
    {
	my $job = SGE::Job->new($node);
	$self->add_job($job);
    }
#    print Dumper($self->{jobs});
}

sub add_job
{
    my($self, $job) = @_;

    push @{$self->{jobs}->{$job->id}}, $job;
}

#
# A job is running if there are any instances that are still running.
#
# We return the list of running jobs; in a scalar context this acts correctly.
#

sub job_running
{
    my($self, $id) = @_;

    my $jobs = $self->{jobs}->{$id};
    my @running = grep { $_->state eq 'running' } @$jobs;
    return @running;
}

sub job_queued
{
    my($self, $id) = @_;

    my $jobs = $self->{jobs}->{$id};
    my @running = grep { $_->state eq 'pending' } @$jobs;
    return @running;
}

sub submit_job
{
    my($self, $meta, $sge_args, $cmd) = @_;
    
    my $sge_cmd = "qsub $sge_args $cmd";
    
    $meta->add_log_entry($0, $sge_cmd) if $meta;

    if (!open(Q, "$sge_cmd 2>&1 |"))
    {
	die "Qsub failed: $!";
    }
    my $sge_job_id;
    my $submit_output;
    while (<Q>)
    {
	$submit_output .= $_;
	print "Qsub: $_";
	if (/Your\s+job\s+(\d+)/)
	{
	    $sge_job_id = $1;
	}
	elsif (/Your\s+job-array\s+(\d+)/)
	{
	    $sge_job_id = $1;
	}
    }
    $meta->add_log_entry($0, ["qsub_output", $submit_output]) if $meta;
    if (!close(Q))
    {
	die "Qsub close failed: $!";
    }

    if (!$sge_job_id)
    {
	die "did not get job id from qsub";
    }

    return $sge_job_id;
}

package SGE::Job;

use Data::Dumper;
use strict;
use base 'Class::Accessor';

__PACKAGE__->mk_accessors(qw(id prio name owner start_time slots tasks state));

sub new
{
    my($class, $node) = @_;


    my $self = {
	node => $node,
    };

    bless($self, $class);

    for my $pair ((['id', 'JB_job_number'],
		   [prio => 'JAT_prio'],
		   [name => 'JB_name'],
		   [owner => 'JB_owner'],
		   [start_time => 'JAT_start_time'],
		   [slots => 'slots'],
		   [tasks => 'tasks']))
    {
	my($name, $key) = @$pair;
	$self->{$name} = $self->getAttr($key);
    }
    $self->state($node->getAttribute('state'));

    return $self;
}

sub getAttr
{
    my($self, $name) = @_;

    my $l = $self->{node}->getChildrenByTagName($name);

    if ($l)
    {
	return $l->item(0)->firstChild->nodeValue();
    }
    else
    {
	return undef;
    }
}
1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3