#!/usr/bin/perl -w

use warnings;
use strict;

package czartool::Pantasks;

my @servers = (
##### standard pantasks ######
        "cleanup", 
        "distribution", 
        "pstamp", 
        "registration", 
        "stack", 
        "stdscience", 
        "summitcopy",
##### additional pantasks ######
        "addstar", 
        "addstarlap",
        "deepstack",
        "detrend", 
        "ippqub:stdscience_ws",
        "publishing", 
        "replication", 
        "update"
        );
# current home dir of gpc1 and gpc2 
my $ipphome1 = "/data/ippc64.1/ippitc";
my $ipphome2 = "/data/ippc18.0/home/ippps2";

###########################################################################
#
# Constructor TODO put in check that we can run pantasks_client
#
###########################################################################
sub new {
    my $class = shift;
    my $self = {};

    bless $self, $class;
    return $self;
}

###########################################################################
#
# Returns the server list as an array 
#
###########################################################################
sub getServerList {
    my ($self) = @_;

    return \@servers;
}

###########################################################################
#
# Returns the correct server for this processing stage 
#
###########################################################################
sub getServerForThisStage {
    my ($self, $stage) = @_;

    if ($stage eq "destreak" or $stage eq "dist") {return "distribution";}
    return "stdscience";
}

###########################################################################
#
# Checks for a meaningful response from pantasks client 
#
###########################################################################
sub outputOk {
    my ($self, $output) = @_;

    if (
            $output =~ m/.*Connection reset by peer.*/i ||
            $output =~ m/.*server is busy.*/i ) { 

        print "* WARNING: pantasks returned '$output'\n";
        return 0;
    }
    return 1;
}

###########################################################################
#
# Gets nightlyscience status for today 
#
###########################################################################
sub getNightlyScienceStatus {
    my ($self, $status,$telescope) = @_;

    my @labels;
    my $ipphome;

    if ($telescope eq 'gpc1') {
       $ipphome = $ipphome1;
    }
    elsif ($telescope eq 'gpc2') {
       $ipphome = $ipphome2;
    }
    else {
        print "WARNING: Must specify a telescope for connecting to the right pantask\n";
    }

    my ($day, $month, $year) = (localtime)[3,4,5];
    my $today = sprintf("%04d-%02d-%02d", $year+1900, $month+1, $day);

    print "stdscience : $ipphome/stdscience/ptolemy.rc\n";
    my @cmdOut = `echo "ns.show.dates;quit" | pantasks_client -c $ipphome/stdscience/ptolemy.rc 2>&1`;
    my $line;
    foreach $line (@cmdOut) {

        chomp($line);
        if (!$self->outputOk($line)) {return 0;}
        if ($line =~ m/$today\s+(.+)/) {
            ${$status} = $1;
            if (${$status} =~ m/ $telescope/) {
            ${$status} = $`;
            }

            return 1;
        }
    }

    return 0;
}

###########################################################################
#
# Gets labels for provided server for gpc1
#
###########################################################################
sub getLabels {
    my ($self, $server,$telescope) = @_;

    my @labels;
    my $ipphome;

    if ($telescope eq 'gpc1') {
       $ipphome = $ipphome1;
    }
    elsif ($telescope eq 'gpc2') {
       $ipphome = $ipphome2;
    }
    else {
        print "WARNING: Must specify a telescope for connecting to the right pantask\n";
    }

    my @cmdOut = `echo "show.labels;quit" | pantasks_client -c $ipphome/$server/ptolemy.rc 2>&1`;
    my $line;
    my $passedHeader=0;
    foreach $line (@cmdOut) {
	# print "labels: $line";
        chomp($line);
        if (!$self->outputOk($line)) {return \@labels;}

        # sometimes a label can be on the same line as the panstasks prompt
        if ($line =~ m/pantasks: (.*)/) {
            $line = $1;
            $passedHeader=1;
        }

	# one line has the show.labels command; skip it
	if ($line =~ m/.*show\.labels.*/i) { next; }

        if ($passedHeader && length($line) > 0){push(@labels, $line);}
    }

    return \@labels;
}

###########################################################################
#
# Returns whether this server is alive and running 
#
###########################################################################
sub getServerStatus {
    my ($self, $server,$telescope, $alive, $running) = @_;

    my $ipphome;

    if ($telescope eq 'gpc1') {
       $ipphome = $ipphome1;
    }
    elsif ($telescope eq 'gpc2') {
       $ipphome = $ipphome2;
    }
    else {
        print "WARNING: Must specify a telescope for connecting to the right pantask\n";
    }

    my @cmdOut = `echo "status ; quit" | pantasks_client -c $ipphome/$server/ptolemy.rc 2>&1`;
    my $line;
    ${$alive} = 0;
    ${$running} = 0;
    foreach $line (@cmdOut) {

        chomp($line);
        if ($line =~ m/Scheduler is stopped/) {${$running} = 0; ${$alive}=1;last;}
        if ($line =~ m/Scheduler is running/) {${$running} = 1; ${$alive}=1;last;}
        if ($line =~ m/Task Status/) {last;}
    }
}

###########################################################################
#
# Gets server status 
#
###########################################################################
sub getServerCurrentStatus {
    my ($self, $server,$telescope) = @_;

    my $ipphome;
    if ($telescope eq 'gpc1') {
       $ipphome = $ipphome1;
    }
    elsif ($telescope eq 'gpc2') {
       $ipphome = $ipphome2;
    }
    else {
        print "WARNING: Must specify a telescope for connecting to the right pantask\n";
    }

    my @cmdOut = `echo "status;quit" | pantasks_client -c $ipphome/$server/ptolemy.rc 2>&1`;
    my $line;
    my $passedHeader=0;
    print "\n";
    foreach $line (@cmdOut) {

        if ($line =~ m/.*Task Status.*/) {$passedHeader=1;next;}
        if ($passedHeader){print "$line";}
    }
}

###########################################################################
#
# Gets revert status for this stage 
#
###########################################################################
sub getRevertStatus {
    my ($self, $stage,$telescope, $reverting) = @_;

    my $ipphome;
    if ($telescope eq 'gpc1') {
       $ipphome = $ipphome1;
    }
    elsif ($telescope eq 'gpc2') {
       $ipphome = $ipphome2;
    }
    else {
        print "WARNING: Must specify a telescope for connecting to the right pantask\n";
    }

    my $server = $self->getServerForThisStage($stage);

    if ($stage eq "cam") {$stage = "camera";}

    my @cmdOut = `echo "status;quit" | pantasks_client -c $ipphome/$server/ptolemy.rc 2>&1`;
    my $line;
    foreach $line (@cmdOut) {

        chomp($line);
        if ($line =~ m/\s+([+-])[+-]\s+$stage\.revert.*/) {

            if ($1 =~ m/-/) {${$reverting} = 0;}
            elsif ($1 =~ m/\+/) {${$reverting}=1;}
        }
    }
}

###########################################################################
#
# Gets current dates for this server
#
###########################################################################
sub getDates {
    my ($self, $server,$telescope) = @_;

    my @dates;

    my $prefix;
    my $ipphome;

    if ($telescope eq 'gpc1') {
       $ipphome = $ipphome1;
    }
    elsif ($telescope eq 'gpc2') {
       $ipphome = $ipphome2;
    }
    else {
        print "WARNING: Must specify a telescope for connecting to the right pantask\n";
    }

    if ($server eq "stdscience") {$prefix = "ns";}
    elsif ($server eq "registration") {$prefix = "register";}

    my @cmdOut = `echo "$prefix.show.dates;quit" | pantasks_client -c $ipphome/$server/ptolemy.rc 2>&1`;
    my $line;
    my $passedHeader=0;
    foreach $line (@cmdOut) {

        chomp($line);
        if (!$self->outputOk($line)) {return \@dates;}

        # sometimes content is on same line as pantasks prompt
        if ($line =~ m/pantasks: (.*)/) {
            $line =~ s/pantasks: //; 
                $passedHeader=1;
        }

        if ($passedHeader && length($line) > 0){

            # strip out only the date part
            if ($line =~ m/([0-9]{4}-[0-9]{2}-[0-9]{2}).*/) {

                push(@dates, $1);
            }
        }
    }

    return \@dates;
}


1;
