package MaplatSVCLinux;
use strict;
use warnings;

use Maplat::Helpers::Cache::Memcached;
use Maplat::Helpers::BuildNum;
use Unix::PID;

sub new {
    my ($class, $isService, $basePath, $memhserver, $memhnamespace,
        $APPNAME, $VERSION, $isCompiled) = @_;
    my $self = bless {}, $class;
    
    $self->{isService} = $isService;
    
    $basePath =~ s/\//\\/g; # Convert to Win32 Path
    $self->{basePath} = $basePath;
    
    if($memhserver ne "none") {
    	my $memd;
        my $memd_loaded = 0;
        # Decide which Memcached module we want to use
        # First, we try the festest one, then the standard
        # one and if everything fails we use our own
        if(eval('require Cache::Memcached::Fast')) {
            print "    Cache::Memcached::Fast available.\n";
            $memd = new Cache::Memcached::Fast {
                            servers   => [ $memhserver ],
                            namespace => $memhnamespace . "::",
                            connect_timeout  => 0,
                        };
            $memd_loaded = 1;
        } elsif(eval('require Cache::Memcached')) {
            print "    No Cache::Memcached::Fast ... falling back to Cache::Memcached\n";
            $memd = new Cache::Memcached {
                            servers   => [ $memhserver ],
                            namespace => $memhnamespace . "::",
                            connect_timeout  => 0,
                        };
            $memd_loaded = 1;
        } else {
            print "    No Cache::Memcached* available ... will try to use MaplatHelpers::Cache::Memcached\n";
        }
    
        # Check if the selected Memcached lib is working correctly
        my $key = "test_" . int(rand(10000)) . "_" . int(rand(10000));
        my $val = "test_" . int(rand(10000)) . "_" . int(rand(10000));
        my $newval;
        if($memd_loaded) {
            $memd->set($key, $val);
            $newval = $memd->get($key);
        }
        if(!defined($newval) || $newval ne $val) {
            if($memd_loaded) {
                print "    Selected Memcached client lib is broken - falling back to MaplatHelpers::Cache::Memcached\n";
            }
            $memd = new MaplatHelpers::Cache::Memcached {
                            servers   => [ $memhserver ],
                            namespace => $memhnamespace . "::",
                            connect_timeout  => 0,
                        };
            $memd->set($key, $val);
            $newval = $memd->get($key);
            if(!defined($newval) || $newval ne $val) {
                die("Maplat Memcached client lib is also broken - giving up!"); 
            } else {
                $memd->delete($key);
            }
        } else {
            $memd->delete($key);
        }
    
    
    
        print "    Selected Memcached library seems to be working. Good!\n";
        $self->{memd} = $memd;
        
        $self->memhset("VERSION::" . $APPNAME, $VERSION);
        $self->memhset("BUILD::" . $APPNAME, readBuildNum(undef, $isCompiled));
        $self->memhdelete("StopSVC");
        $self->{is_configured} = 0;
    }
    
    return $self;
}

sub requestStop {
    my ($self) = @_;
    
    my $tmp = 1;
    $self->memhset("StopSVC", $tmp);
}

sub shouldStop {
    my ($self) = @_;
    
    my $stop = $self->memhget("StopSVC");
    if(!defined($stop) || $stop != 1){
        return 0;
    } else {
        return 1;
    }
    
}

sub setServerStatus {
    my ($self, $status) = @_;

    $self->memhset("SVCRunningStatus", $status);
}

sub getServerStatus {
    my ($self) = @_;
    
    my $status = $self->memhget("SVCRunningStatus");
    if(!defined($status)){
        return "stopped";
    } else {
        return $status;
    }
    
}

sub startconfig {
    my ($self) = @_;
    
    $self->{apps} = ();
    $self->{startup_scripts} = ();
    $self->{shutdown_scripts} = ();
}

sub configure_module {
    my ($self, $module) = @_;
    
    print "Configuring module " . $module->{description} . "...\n";
    $module->{handle} = undef;
    
    my $fullapp = $module->{app};
    $module->{app} = $fullapp;

    my $fullconf = $module->{conf};
    $module->{conf} = $fullconf;
    
    
    push @{$self->{apps}}, $module;
}

sub configure_startup {
    my ($self, $command) = @_;
    
    $command =~ s/\//\\/g;
    push @{$self->{startup_scripts}}, $command;
}

sub configure_shutdown {
    my ($self, $command) = @_;
    
    $command =~ s/\//\\/g;
    push @{$self->{shutdown_scripts}}, $command;
}

sub endconfig {
    my ($self) = @_;
    
    # "Don't fear the Reaper"
    $SIG{CHLD} = 'IGNORE';
    
    foreach my $script (@{$self->{startup_scripts}}) {
        $self->run_script($script);
    }
    print "Startup scripts complete\n";
    
    foreach my $app (@{$self->{apps}}) {
        $self->start_app($app);
    }
    print "Initial apps startup complete\n";
    $self->{shutdown_complete} = 0;
    $self->{is_configured} = 1;
    
}

sub work {
    my ($self) = @_;
    
    my $workCount = 0;
    
    foreach my $app (@{$self->{apps}}) {
        if(!$self->check_app($app)) {
            print "*** App " . $app->{description} . " FAILED! ***\n"
        }
        
        $workCount++;
    }    
    
    return $workCount;
    
}

sub shutdown {
    my ($self) = @_;
    
    if($self->{is_configured} == 1) {
        print "Shutdown started.\n";
        
        foreach my $app (@{$self->{apps}}) {
            $self->stop_app($app);
        }
        
        print "Apps shut down.\n";
        
        foreach my $script (@{$self->{shutdown_scripts}}) {
            $self->run_script($script);
        }
        print "Shutdown scripts complete\n";
    }
    $self->{shutdown_complete} = 1;
    return;
}

sub DESTROY {
    my ($self) = @_;
    
    if(!$self->{shutdown_complete}) {
        $self->shutdown();
    }
}

sub check_app {
    my ($self, $app) = @_;
    
    if(!defined($app->{handle})) {
        return $self->start_app($app);
    }
    
    my $checker = Unix::PID->new();
    
    # First, check if the process exited
    if(!$checker->is_pid_running($app->{handle})) {
        # Process exited, so, restart
        print "Process exit detected: " . $app->{description} . "!n";
        return $self->start_app($app);
    }
    
    if(!defined($app->{lifetick}) || $app->{lifetick} == 0) {
        return 1;
    } else {
        # Process itself is still running, so check its lifetick
        # to see if it hangs
        my $pid = $app->{handle};
        my $apptick = $self->memhget("LIFETICK::" . $pid);
        if(defined(!$apptick)) {
            #print "Apptick not set for " . $app->{description} . "!\n";
            return 1;
        } elsif($apptick == 0) {
            # Client requested a temporary suspension of lifetick handling
            return 1;
        }
        my $tickage = time - $apptick;
        if($tickage > $app->{lifetick}) {
            # Stale lifetick
            print "Stale Lifetick detected: " . $app->{description} . "!\n";
            $self->stop_app($app);
            return $self->start_app($app);
        } else {
            return 1;
        }
        
    }
    
}

sub start_app {
    my ($self, $app) = @_;
    
    my $pid = fork();

    if($pid) {
        #parent
        print "Forked " . $app->{app} . " has PID $pid\n";
        $app->{handle} = $pid;
        my $stime = time;
        $self->memhset("LIFETICK::" . $pid, $stime);
    } else {
        # Child
        exec($app->{app} . " " . $app->{conf}) or die("Can't exec");
        print "Child done\n";
        exit(0);
    }
}

sub stop_app {
    my ($self, $app) = @_;
    
    if(defined($app->{handle}) && $app->{handle}) {
        my $pid = $app->{handle};
        print "Killing app " . $app->{description} . " with PID $pid...\n";
        kill 15, $pid; # SIGTERM
        sleep(2);
        kill 9, $pid;  #SIGKILL
        $app->{handle} = undef;
        print "...killed.\n";
        $self->memhdelete("LIFETICK::" . $pid);
    } else {
        print "App " . $app->{description} . " already killed\n";
    }
    
}

sub run_script {
    my ($self, $command) = @_;
    
    print "Running command '$command':\n";
    my @lines = `$command`;
    foreach my $line (@lines) {
	chomp $line;
	print ":: $line\n";
    }
                
    return 1;
}

sub memhget {
	my ($self, $key) = @_;
	
    return if(!defined($self->{memd}));
    
	$key = $self->memhsanitize_key($key);
	
	return $self->{memd}->get($key);
}

sub memhset {
	my ($self, $key, $data) = @_;
	
    return if(!defined($self->{memd}));
    
	$key = $self->memhsanitize_key($key);
	
	return $self->{memd}->set($key, $data);
}

sub memhdelete {
	my ($self, $key) = @_;
	
    return if(!defined($self->{memd}));
    
	$key = $self->memhsanitize_key($key);
	
	return $self->{memd}->delete($key);
}

sub memhsanitize_key {
	my ($self, $key) = @_;
	
	# Certain chars are not allowed in keys for whatever reason.
	# This *should* be handled by the Cache::Memcached module, but isn't
	# We handle this by substituting them with a tripple underline
	
	$key =~ s/\ /___/go;
	
	return $key;
}

1;