File Coverage

blib/lib/HTCondor/Queue/Parser.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package HTCondor::Queue::Parser;

use strict;
use warnings;
use XML::Simple;
use JSON::XS;

# ABSTRACT: parses multible schedds condor_q output, so you don't have to. Serves output in many formats.

sub new {
	my $class = shift;
	my $self  = bless { @_ }, $class;
	return $self;
}

my %schedds_map;
my $schedd;
my @submitter_xml;

sub load_schedds_xml {
	my $self = shift;
	my $condor_q = shift;
	my @text = @{$condor_q};
	my %schedds_map;
	my $schedd;


	die("Got no input. Check condor_q -xml output") if (scalar(@text) < 1);

	foreach my $line (@text) {

		if ($line =~ m/^--.*Schedd\:(.*)\s\:(.*)/) {
			# $2 is useful but not used -- IP
			$schedd = $1;
		}
		if ($line =~ m/\/) {
			# New scheed, record previous in the map and reset everything
			$schedds_map{$schedd}{'xml'} = \@submitter_xml;
			@submitter_xml = ();
		}
		push(@submitter_xml, $line);
	}
	return %schedds_map;
}
sub convert_to_compatible_xml {
	my $self = shift;
	my $schedds_map_href = shift;
	my %schedds_map = %{$schedds_map_href};

	foreach my $schedd (keys %schedds_map) {

		die("There's no XML in the provided schedds_map , verify") if not $schedds_map{$schedd}{'xml'};
		my @real_xml=();

		 foreach my $line  (@{$schedds_map{$schedd}{'xml'}}) {
			 chomp $line;

			 #
			 # Machine
			 if ( $line =~ m/\\<.*\>(.*)\<.*\>\<\/a\>/ ) {
				 push(@real_xml, "<$1> $2 " );
			 }
			 elsif ($line =~ m/\\\<\/a\>/) {
				 push(@real_xml, "<$1> $2 " );
			 }
			 else {
				push (@real_xml, $line);
			 }
		 }

		$schedds_map{$schedd}{'xml'} = \@real_xml;
		# Check if there's any big difference on using the
		# Below or not, and how compatible it is with the API
		# my $job_data = XMLin($xml);
		# $self->{'schedds_map'}{$schedd}{'href'} = $job_data;
	}
	return %schedds_map;
}

sub xml_to_hrefs{
	my $self = shift;
	my $schedds_map_href = shift;
	my %schedds_map = %{$schedds_map_href};

	foreach my $schedd (keys %schedds_map) {
		die ('Provide an xml in %schedds_map{$schedd}{xml} ') if not defined $schedds_map{$schedd}{'xml'} ;
		my $xml = "@{$schedds_map{$schedd}{'xml'}}";
		my $job_data = XMLin($xml);
		$schedds_map{$schedd}{'href'} = $job_data;
	}
	return %schedds_map;
}

sub schedd_json {
	my $self = shift;
	my $schedds_map_href = shift;
	my $schedd = shift;
	my %schedds_map = %{$schedds_map_href};

	die("Which schedd?") if not $schedd;
	die('Come on, ask me something that exists, populate $schedds_map{$schedd}') if not $schedds_map{$schedd}{'href'};
	my $coder = JSON::XS->new->ascii->pretty->allow_nonref;
	my $json = $coder->encode($schedds_map{$schedd}{'href'});
	return $json;
}


1;


__END__