#!/usr/bin/perl -w

use warnings;
use strict;

package czartool::Pantasks;

my @servers = (
        "addstar", 
        "addstarlap", 
        "cleanup", 
        "deepstack",
        "detrend", 
        "distribution", 
        "pstamp", 
        "update", 
        "publishing", 
        "registration", 
        "replication", 
        "stack", 
        "stdscience", 
        "summitcopy"
        );

###########################################################################
#
# 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/.*show\.labels.*/i ||
            $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) = @_;

    my @labels;

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

    my @cmdOut = `echo "ns.show.dates;quit" | pantasks_client -c ~ipp/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;
            return 1;
        }
    }

    return 0;
}

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

    my @labels;

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

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

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

    return \@labels;
}

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

    my @cmdOut = `echo "status ;quit" | pantasks_client -c ~ipp/$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) = @_;

    my @cmdOut = `echo "status;quit" | pantasks_client -c ~ipp/$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, $reverting) = @_;

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

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

    my @cmdOut = `echo "status;quit" | pantasks_client -c ~ipp/$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) = @_;

    my @dates;

    my $prefix;

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

    my @cmdOut = `echo "$prefix.show.dates;quit" | pantasks_client -c ~ipp/$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;
