#!/v/openpkg/sw/bin/perl

#   Perl requirements
require 5.008;
use IO::All;
use OSSP::uuid;
use Date::Format;
use DBI;
use DBD::Pg;
use DBIx::Simple;

#   utility function for logging
sub log ($@) {
    my ($fmt, @args) = @_;
    my $msg = time2str("%Y-%m-%d-%H:%M:%S", time()) . " " . sprintf($fmt, @args) . "\n";
    $msg >> io("token.log");
}

#   connect to Registry DB
my $db = DBIx::Simple->connect(
    "dbi:Pg:dbname=registry", "registry", "registry",
    { RaiseError => 0, AutoCommit => 0 }
) or die $db->error();

#   determine today's token name
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time());
my $token_name = sprintf("OpenPKG Demo Token %d", $wday);

#   generate new UUID
my $uuid = new OSSP::uuid;
$uuid->make("v1");
my $token_uuid = $uuid->export("str");
undef $uuid;
$token_uuid =~ s/-[0-9a-f]{12}$/-0050c2658001/;

#   store UUID into Registry DB for FTP access and
#   store UUID into textfile for Web display
$db->query(q{
    UPDATE reg_token
    SET    id = ?
    WHERE  description = ?;
}, $token_uuid, $token_name) or die $db->error();
$db->commit();
$token_uuid > io("token.txt");
&log("update: token=\"%s\" uuid=\"%s\"", $token_name, $token_uuid);

#   delete out-dated registrations
foreach my $h ($db->query(q{
    SELECT *
    FROM   reg_instance 
    WHERE  registry_user = 'demo@openpkg.org' AND
           registry_date < ?;
}, time() - (60*60*24*2))->hashes()) {
    &log("delete instance: uuid=\"%s\" description=\"%s\" platform=\"%s\" release=\"%s\"",
         $h->{"uuid_instance"}, $h->{"registry_desc"}, $h->{"registry_plat"}, $h->{"registry_orel"});
}
$db->query(q{
    DELETE 
    FROM   reg_instance
    WHERE  registry_user = 'demo@openpkg.org' AND
           registry_date < ?;
}, time() - (60*60*24*2)); # or die $db->error();
$db->commit();

#   disconnect from Registry DB
$db->commit();
$db->disconnect();
undef $db;