package TextLogger;
use strict;
use warnings;

use Helpers;

sub new {
    my ($class, %config) = @_;
    my $self = bless \%config, $class;

    
    $self->log("Logfile for " . $self->{appname} . " (re)started");
    return $self;
}

sub log {
    my ($self, $logline) = @_;
    
    my $fullline = Helpers::getISODate() . "  $logline\n";
    
    open($self->{fh}, ">>", $self->{logfile});
    print {$self->{fh}} $fullline;
    close($self->{fh});
    print $fullline . "\n";
}

sub alive {
    my ($self) = @_;
    
    $self->log("-- " . $self->{appname} . " is alive --");
}

sub DESTROY {
    my ($self) = @_;
    
    $self->log("Stopping logfile");
    
}

1;

##</code><code>##

package PerlSvc;
use strict;
use warnings;

use Time::HiRes qw( sleep );
use IO::Socket;
use TextLogger;

# the short name by which your service will be known (cannot be 'my')
our $Name = "pmtimesrv";
# the display name. This is the name that the Windows Control Panel
# will display (cannot be 'my')
our $DisplayName = "PerlMonks Time Server";

# the startup routine is called when the service starts
sub Startup {
    # Start listening to our server socket
    my $server = IO::Socket::INET->new(LocalPort => 64100,
                                Type      => SOCK_STREAM,
                                Reuse     => 1,
                                Listen    => 10 )   # or SOMAXCONN
    or die "Couldn't be a Time server on port 64100 : $@\n";

    my $oldfh = select($server);
    $| = 0;
    select($oldfh);
    my $temp = 1;
    ioctl ($server, 0x8004667E, \$temp); # set non-blockin

    # Make a new logger
    my $logfilename = 'C:\Programme\PerlMonks\TimeServer.log';
    my $logger = new TextLogger(logfile		=> $logfilename,
				appname		=> 'TimeServer');

    $logger->log("Starting to serve timestamps");

    my $alivecount = 36000;

    while (ContinueRun()) {
	$alivecount--;
	if(!$alivecount) {
	    $alivecount = 36000;
	    $logger->alive();
	}
	
        my $client = $server->accept();

        # see if there are new clients waiting
        if(!defined($client)) {
            # ok, no client waiting, sleep a short time and retry
            sleep(0.1);
            next;
        }
	$logger->log("Connection from: " . $client->peerhost);
	print $client getDateTime();
	close $client;
    }
    
    $logger->log("Someone has set up us the bomb!"); # mandatory AYBABTU quote
}

sub Install {
    # add your additional install messages or functions here
    print "The $Name Service has been installed.\n";
    print "Start the service with the command: net start $Name\n";
}

sub Remove {
    # add your additional remove messages or functions here
    print "The $Name Service has been removed.\n";
}

sub Help {
    # add your additional help messages or functions here
    print "$Name Service -- use '--install' to install, '--remove' to uninstall. Or run interactive.\n";
}

sub Interactive {
    Startup();
}

# ---- HELPERS ----

sub doPad {
    my ($val, $len) = @_;
    while(length($val) < $len) {
	$val = "0$val";
    }
    return $val;
}

sub getDateTime {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time());

    return	doPad($mday,2) . "-" .
		doPad($mon+1,2). "-" .
		($year + 1900) . " " .
		doPad($hour,2) . ":" .
		doPad($min, 2) . ":" .
		doPad($sec, 2) . "\n";

}

##</code><code>##

package PerlSvc;
use strict;
use warnings;

use IO::Socket;
use Time::HiRes qw( sleep );
use Data::Dumper;
use TextLogger;
use Helpers;

# the short name by which your service will be known (cannot be 'my')
our $Name = "pmtimeclnt";
# the display name. This is the name that the Windows Control Panel
# will display (cannot be 'my')
our $DisplayName = "PerlMonks Time Client";

# the startup routine is called when the service starts
sub Startup {
    my $waitcount = 300; # <- Wait 30 seconds at startup for things to settle down...
    my $logfilename = 'C:\Programme\PerlMonks\TimeClient.log';
    my $logger = new TextLogger(logfile		=> $logfilename,
				appname		=> 'TimeClient');
    my $alivecount = 36000;

    while (ContinueRun()) {
	$alivecount--;
	if(!$alivecount) {
	    $alivecount = 36000;
	    $logger->alive();
	}
	
	$waitcount--;

	if(!$waitcount) {
	    $logger->log("Start of syncronize cycle");
	    my $socket = IO::Socket::INET->new(PeerAddr => "127.0.0.1",
					PeerPort => 64100,
					Proto    => "tcp",
					Type     => SOCK_STREAM);

	    if(!$socket) {
		#print "Socket error...\n";
		$waitcount = 600; #try again in a minute
		$logger->log("Socket error");
	    } else {
		foreach my $line (<$socket>) {
		    $logger->log("Parsing reply...");
		    if($line =~ /(\d\d-\d\d-\d\d\d\d)\ (\d\d\:\d\d\:\d\d)/) {
			my ($dstamp, $tstamp) = ($1, $2);

			system("cmd.exe /c date $dstamp");
			system("cmd.exe /c time $tstamp");
			$logger->log("SET: Date = $dstamp / Time = $tstamp");
		    }
		}
		close $socket;
		$waitcount=36000; # wait an hour
	    }
	}
	sleep(0.1);
	
    }
    $logger->log("For great justice!"); #AYBABTU!!1!
}

sub Install {
    # add your additional install messages or functions here
    print "The $Name Service has been installed.\n";
    print "Start the service with the command: net start $Name\n";
}

sub Remove {
    # add your additional remove messages or functions here
    print "The $Name Service has been removed.\n";
}

sub Help {
    # add your additional help messages or functions here
    print "$Name Service -- add custom help message here.\n";
}

sub Interactive {
    Startup();
}

##</code><code>##

H4sICEUa804CA2Nsb2NrLmJtcADNWndYlEcT/ykoiAUVgyXG3rDH2MWOiN2onyUqGBv2GivWxJqo
GDU2sFcsWFEUe0ExohSxIaAoRQEr7KTn23J3HAd3nMgf2eeB2zK7szszO23fdt2q1YIs9pZADf47
XPOXB9ayv2h1wK6g+vsN6k+UPHnyIG/evLCwsIClpSXy5cuH/Pnzw8rKCtbW1ihQoABsbGxQsGBB
FCpUCIULF0aRIkVga2uLokWLolixYrCzs0OJEiXw2Wefwd7eHiVLlkSpUqVQunRplClTBp9//jnK
li2LL774AuXKlUP58uVRoUIFVKxYEZUqVULlypVRpUoVVK1aFdWqVUP16tVRo0YNODg4oGbNmqhV
qxZq166NOnXqoG7duqhXrx7q16+PL7/8El999RUaNmyIRo0aoXHjxmjSpAmaNm2KZs2aoXnz5mjR
ogUcHR3RqlUrtG7dGm3atEHbtm3Rrl07tG/fHk5OTujQoQOcnZ3RsWNHuLi4oFOnTujcuTO6dOmC
rl27olu3bujevTt69OiBnj174uuvv0avXr3Qu3dv9OnTB3379kX//v0xYMAAfPPNNxg4cCAGDRqE
wYMHw9XVFW5ubhgyZAi+/fZbDB06FMOGDcPw4cMxYsQIuLu7Y9SoURg9ejTGjBmDsWPHYty4cRg/
fjwmTpyISZMmYfLkyZgyZQqmTp2KadOmYfr06ZgxYwZmzpyJWbNmYfbs2fDw8MCcOXMwd+5czJs3
D/Pnz8eCBQuwcOFCfP/99/jhhx+waNEiLF68GEuWLMHSpUuxbNkyLF++HD/++CN++uknrFixAitX
rsSqVavg6emJ1atX4+eff8aaNWuwdu1arFu3Dr/88gvWr1+PDRs2YOPGjdi0aRM2b94MLy8veHt7
Y8uWLdi6dSu2bduG7du3Y8eOHdi5cyd27dqF3bt3Y8+ePdi7dy/27duH/fv3w8fHBwcOHMDBgwdx
6NAhHD58GL6+vjhy5AiOHj2KY8eO4fjx4zhx4gROnjwJPz8/nDp1CqdPn4a/vz/OnDmDs2fPIiAg
AOfOncP58+dx4cIFXLx4EZcuXcLly5dx5coVXL16FdeuXcP169cRGBiIGzdu4ObNmwgKCsKtW7fw
66+/4vbt2wgODsadO3dw9+5dhISEIDQ0FGFhYQgPD8e9e/cQERGB+/fv48GDB3j48CEePXqEx48f
IzIyEk+ePEFUVBSio6MRExODp0+f4tmzZ4iNjcXz58/x4sULxMXFIT4+HgkJCUhMTMTLly/x6tUr
JCUlITk5GSkpKXj9+jXevHmDt2/f4t27d3j//j0+fPiA1NRUpKWlgTEGIsJvv/2G33//HX/88Qf+
/PNP/PXXX/j777/xzz//4N9//xUw/63yKuLSob17D12MeClaLDeX5ovFbh/frBj0StHGY7dE5R6e
N15dCyHLYt1xw6vcOIFnc5gsDVd+0mkYPexrsGJhu1Kl7QobdPYKySkWRpebpK9ToMfcg8Gp2rHU
275zehTQO8zlnGDhZ2ikW6L71kTSkySmqSTu6JlXC9Ig9KOxsHdu2tltfNTijNIWB5O3s7MnXV2m
Y9fRjlq4/6V85CF886iJRWaniJUYXbN/w2/0zzQDcKfZVkSPy4aqkffzS2iw7PiIo7BUFw2H18j2
wdZET3CcqPB0hcPNgZgXPhA1OiUBvOwUvOM7s5Hc1XBzkdhmGLFdeMDPMJuotqvC0aYDkWsZYgEI
kABEKxVj8l81E8UahaH1W9HwkFpvLlGTxkTzNiscS/n57PsQDc9L9Bqekldd1KwfzKAXo/ES1uIw
r/qMpLdYTuRYluh2vJwtcQiw6HuMMIBoAt9E/5O8w1+d3i1bJIy6ScgmnLKpdYFg6l+MKChON0+D
Q5XHERzPZDoDNOVT09rLqa2yQcJIaY5JEq4V4EDhDRP0ITLg4CWi1msqxa+6nPy9nFyPMZMoWkoo
b15v7EFPeXWngTYyxMEHl3OwFBrZkbcOKSQmT9JdwtwQ1Wm4Q6MAGwMIQxz8tvIZ8+k0VohWmGV2
5JokAPKFcgbzhkNxIgtgWjY4aDBQjF5atCExjUUWUow3VjbIU4QwCuQkYi+qPaW1vP2SGWxjSIZj
3OMgR1ho5Q+MfuL3iEVaKhHOmhmhEsU1UXfFVSY1XzmuEDNApaWmpmXoqA80VmryIKaLZcLkMldZ
lvy2FWNeXCIl71XnJd510xQH93GASAkQj//x/w81jM+fpVrpIYYmEJf2VRyJn6bXCahqStq5vRqm
qR7g06aBs1KKsGMWx/CTtkZUv8NUnVywOH6/koyjeFwdeXTXgVFfJV3tlRbORCkLEUilSHBP3Eof
WXDUlLQz2rgpvcVdYNmZJtVKiuG8kaJ3N1HzXXxegsEtM7skcOjVzsT8pdEy2E6M6GzGxaYf+nyS
m8HayfsjtXBoxoWcRF8yk4LS8VO8pcqWZyW1hD1pkAF7uEDhwe1a33cU+fRTzhGSRG/7NOJGS6x4
WX8lZ+H0ETvKfxZ/mn/JaCFf5CgjO62YavqFghW2aKCM6v1zjoXRCWnaB3Ibr9FL2jJUOGli5YDS
0tuJzSmGKGl+ylwQdeGt9EofFHdjPNE6UsZAXvecFHkBwB1gWks0X9R16LeJVhydRQGuLt9Jglnv
/3gMXlLjuqWx99Pz4ld6r8UnSwfeaCR8y9Fw4YcMFemWfR+PY50QV67dqUqeKcKn6ajHdSYQbuXa
mft8z6Trt8OmQU5IVcn2gHQdHymfWEgpVHzCfBThfIP09EZUTtzwx+lON13hilvcww2qq5+0wFQR
tqNiKVfKPVdrQaWefGGN0ijDq56cUOfchAubGyXcctQVTvod8maLIvwKRKgT5l6oKlZKFCtHidYR
xY7w3IyGxUJ828KMbBH1ObzSkvvNqDHEHHZEB8VkDxQ2qBKKK/M9VqsPeeXJFld7c7Y4EfmyB3r0
xdCdMWr7jUW7onA+mdnsGIzaZpPLVyQLRENogADzzWprOJuHQPiNWpUlfmNpavEGPX3M2Z+DdDSz
282a7vVtF7NUsfZLbuYVrvMLvm2/05xzFMZM/n9PjUkmoZZ0GrHwmto/l68QiYOZLbfAL7TINpPX
kTXFREbiItEF/sPDus0zdGWiqXkpQFs+Y1R81ptKG+KuKzxOFEbxEJG/uvDOevkPUzsTyrToUqMM
SdVbhsuGMKt7FQ4rc3HsqZmVk2kcRymFQ0Mr73RaTTAmjoINlWEyPZg2KX0dbx2twrQ7Z6a8T0Zx
7pINi7hzYfYdlDy/pJPdm+vnDTnJjMIHdlZsoBGoYA4G7xHzNwXrZFdzB8egdIP1pthQe78mKm1h
Do659UphrrqDwtrmN6lLNGzoEqQZ/JL73GbrkmAtHyrx300saxyM4kdlvA1lhCNmbjkIEfPywimN
ccQ+nJrVJBOGIO7j2y7SRw4sM0MjPGu14Ay33nNVwKH8OWmjCrY1sD77awM19xiqkt1mHCDIMR8K
Kxslj31cEe3qSwOCLi0KdA40oN8TKYvmlOc3la3drrua9yljUlKywT0uE4eu8EjZbHYkKpEVhcf5
PBxlFOFR3igbdFIMc14BYqosiuK+z1a+cCHVM0hF03U4aZ4YY4O2/GgWjiCumtuoDE9Xte3DiiE7
j6Wz4a4xvToBJY1fiiQ9X/TAAXW7vZhWVoCN0qdWbHh9saSxi9YX9Yxv/yuH29LzeKV8aulHv9GM
dZF5LZW+4myIbc3b17M+iCO6GT2GoMfXybxW116GHW14u7l2UPiliGbnFRvGSOW/2oj7j6FGj7FQ
TpxF9HAwcFtYTIicqaaIp+LRHCiVaH0+aLeTVbHBPOPXPL6zTDxzo/RhAdHsjOZOmAYLQcpAobxQ
PcioB8EDClOa8FoFMb9uiKgX4bW+6WPShiwQHBWZJ2/jPspLwM+0vlV0cNdkoh/qreQiD0Ibswtp
bwF3s7scY/kie5QJbJIplzGZqJrTC0pOMk7xE0CyacPxjCjWqSY3OplyGTIGRTzjTL9o3clk6JrN
KaqW4MxIZW+hiZX10Mer3C+xCWjx1vg5PLT6x+g54mqKBwBqbcgNFVbwspm7zMsMOa7fHILq2eWv
aEYjjXrKnOSV6blEueBhhKT3e+oLsosIgDNu4KCezfLDdZW6lonDTJlRmWWFg3wR1HMLGJfWfq91
zToio5MhcmuqF1aJlK3U1/I9zjcLkg/QnO+sTItqT9IN+Ez/mht6DFbAGK1g82muCNak1F2yvD7F
NVkskdLvrckhB/Iuv/QNBZ++bzBtCweIkQAJcm+B3H+T74mpWSaqI6VOOy3qU+GrQhKuW1qYTpI6
SAgBvEold2/IZe4aEc7dcpSzLVDY3jedkmWWPzoDtBuQIT5hdzjISRbrzJF8h0farP2abLQzRyJy
m02tkogrn5EZQbj6nGFotmBHD9CbV8/wsEzqK1N+nms6uZbgglA9FgbkyYRDvrEspF3YIlrX5ALd
TKrNTlCMZ1RrrHwrWmvAA0McfHAxB3tN/QTfZKKSGz9mBhI3yURuLMtTTP9XpnBE90gle3BKpfEJ
E+Tkltk+rClyOSRyzcZF5goNtSIWlT5LHwej51z5zRfhntDiKQ3VI7UZD4SK8Vx3Mdrah5hQcU6f
c41N8g1Cg0P4MIyEcR/Gg8l+4g1ydx69Z7/sihJh1ItXmpbre3xH1LwBD7CPKRy7fIiKfsNVg43Q
2KvFzpKbqVkbzPRTI4sr+Mli8hViB3CHh0K8VXugwtGCm5j+FYidEs9O8hMADzXDNtT8DNcANcVi
gRScnXV4RMFvPhWbonAMqkNsndA2lX3lhOXqGzj0+JgHdLqked62GB2tkk4X8yVxmq1WOGbaED2w
uaNG4sZrYf0+LpHHlNGSfNmo7WJTbpCns7M3nZuuuxxbdV89jMxBqjBe96UCHFfcJ+1HDfoZQ89W
OhCnmJx9mRHuopeZaDluU4Au3xgb4D22pX7aIjznX5gkuFsbfK+S18o6r0GXxdCnn/alDO3oYvpb
nA7bPj1ny+cfHlQu6/XL9PNhuZQU5qukHp/fuVL+9NUtKzrPOfIul7/BUiUh7IK//4WQBPrPlf8D
MsEJPyYrAAA=

##</code><code>##

base64 -d clock.bmp.gz.base64 | zcat > clock.bmp

##</code><code>##

#!/usr/bin/perl -w
use strict;
use warnings;

use IO::Socket;
use Tk;

my $splash;
my $picfile = "clock.bmp";
if(defined($PerlApp::VERSION)) {
	$picfile = PerlApp::extract_bound_file($picfile);
}

require Tk::Splash;
$splash = Tk::Splash->Show($picfile, 100, 100, "PerlMonks Time Sync",
						   undef);
for(1..5) {
	DoOneEvent();
}


my $socket = IO::Socket::INET->new(PeerAddr => "127.0.0.1",
			PeerPort => 64100,
			Proto    => "tcp",
			Type     => SOCK_STREAM);

die("Can't open connection to time server!") if(!$socket);

foreach my $line (<$socket>) {
	if($line =~ /(\d\d-\d\d-\d\d\d\d)\ (\d\d\:\d\d\:\d\d)/) {
	my ($dstamp, $tstamp) = ($1, $2);
		sleep(1);
		system("cmd.exe /c date $dstamp");
		system("cmd.exe /c time $tstamp");
		last;
	}
}
$splash->Destroy;