#! /usr/bin/perl

use strict ;
use warnings ;

use Dmon ;

my $TMP_HDIR = 'works' ;

###################################################################
package Line ;
use base 'OBB' ; __PACKAGE__ -> mk_getset ( qw(txt num) ) ;

sub add
  { my $self = shift ;
    my $suff = shift ;
    $self -> { txt } .= $suff ;
    $self ;
  }

###################################################################
package ConfServ ;
use base 'OBB' ; __PACKAGE__ -> mk_getset ( qw(name show) ) ; 

sub to_work
  { my $self = shift ;
    { hnam => $self -> name
    , show => $self -> show
    }
  }

###################################################################
package ConfHost ;
use base 'ConfServ' ; __PACKAGE__ -> mk_getset ( qw(alis) ) ; 
sub Defs { ( alis => {} ) ; }

sub Init { my $self = shift; $self -> ConfServ::Init ( @_ ) ; }

sub add_ali
  { my $self = shift ;
    my $ali  = shift ;
    $self -> alis -> { $ali } = $self -> name ;
    $self ;
  }

###################################################################
package Meta::Conf ;

use constant FILES => ( 'work.conf', Dmon::CDIR . '/work' ) ;

use constant
  { SERV  => 'server'
  , SERVS => 'servers'
  , HOST  => 'host'
  , HOSTS => 'hosts'
  , ITEM  => 'item'
  , ITEMS => 'items'
  , GET   => 'get'
  , GETS  => 'xgets'
  , ALIA  => 'alias'
  , TIME  => 'stamp'
  , HTML  => 'html'
  } ;

our @KEYS  = ( SERV, HOST, HOSTS, ALIA, ITEM, ITEMS, GET, HTML ) ;

use base 'OBB' ;
__PACKAGE__ -> mk_getset ( @KEYS, GETS, qw(_file _lines) ) ;

sub Defs
  { ( SERV  () => {}
    , HOST  () => {}
    , HOSTS () => {}
    , ITEM  () => {}
    , ITEMS () => {}
    , GET   () => {}
    , GETS  () => []
    , ALIA  () => {}
    , _file  => 'not_defined'
    , _lines => []
    ) ;
  }

our %KEYS ; $KEYS { $_ } ++ for @KEYS ;
our @FILES = FILES ;

sub Init
  { my $self = shift ;
    my %opts = @_ ;
    my $optw = $opts { file } ;
    my $file = _use_file ( $optw || @FILES ) ;
    $self -> Die
      ( $optw
      ? "can't find work config file [$optw]"
      : sprintf "no work config found [%s]", join ',', @FILES
      ) unless defined $file ;
    $self -> OBB::Init ( _file => $file ) ;
    $self -> get_lines ;
    $self -> set_item ;
    $self -> mk_tab ;
    $self -> _check ;
    $self -> Dmp ( 'meta work' ) if $self -> Debug ;
    $self ;
  }

sub _use_file
  { for my $cand ( @_ ) { return $cand if defined $cand and -r $cand ; }
    undef ;
  }

sub _check
  { my $self = shift ;
    my $html = $self -> html ;
    my $path = $self -> _file ;
  }

sub strip { my $x = shift ; $x =~ s/^\s+// ; $x =~ s/\s+$// ; $x ; }

sub set_item
  { my $self = shift ;
    $self -> item ( Items -> Make -> as_hash ) ;
  }

sub get_lines
  { my $self = shift ;
    my $pth = $self -> _file ;
    my $res = [] ;
    open CONF, '<', $pth or OBB -> Xit ( "can't open $pth ($!)" ) ;
    while ( my $line = <CONF> )
      { chomp $line ;
        next if $line =~ /^#/ ;
        next if $line =~ /^\s*$/ ;
        if ( $line =~ /^\s/ )
          { OBB -> Die ( "bad indent on line $." ) if @$res == 0 ;
            @$res [ $#$res ] -> add ( ' ' . strip $line ) ;
          }
        else
          { push @$res, Line -> Make ( num => $., txt => strip $line ) ; }
      }
    close CONF ;
    if ( $self -> Debug ) { printf "%s\n", $_ -> txt for @$res ; }
    $self -> _lines ( $res ) ;
    $self ;
  }

sub insert
  { my $self = shift ;
    my $tabl = shift ;
    my $name = shift ;
    my $item = shift ;
    my $lnum = shift ;
    if ( exists $self -> $tabl -> { $name } )
      { my $dub = $self -> $tabl -> { $name } ;
        OBB -> Die ( "already have $tabl $name ($dub) [line $lnum]" ) ;
      }
    $self -> $tabl -> { $name } = $item ; 
  }

sub find ;
sub find
  { my $self = shift ;
    my $tabl = shift ;
    my $name = shift ;
    my $lnum = shift ;
    if ( $name =~ /^@/ )
      { $self -> find ( $tabl . 's', substr $name, 1 ) ; }
    else
      { OBB -> Xit ( "can't find $tabl $name" )
          unless exists $self -> $tabl -> { $name } ;
        $self -> $tabl -> { $name } ;
      }
  }

sub have
  { my $self = shift ;
    my $tabl = shift ;
    my $name = shift ;
    $self -> $tabl -> { $name } ;
  }

sub mk_tab
  { my $self = shift ;
    my $lines = $self -> _lines ;
    for my $line ( @$lines )
      { my ( $key, $val ) = split ' ', $line -> txt, 2 ;
        my $num = $line -> num ;
        die "bad key '$key' on line $num\n" unless exists $KEYS { $key } ;
        die "missing value on line $num\n" unless defined $val ;
        printf "LINE : <%s>\n", $line -> txt if $self -> Debug ;
        my @vals = split ' ', $val ;
        if ( $key eq SERV )
          { die "more than val on line $num\n" if @vals > 1 ;
            my $h = $self -> find ( HOST, $val ) ;
            my $serv = ConfServ -> Make ( %$h ) ;
            $self -> insert ( SERV, $serv -> name, $serv, $num ) ;
          }
        elsif ( $key eq HOST )
          { my ( $h, @a ) = split ' ', $val ;
            my $host = ConfHost -> Make ( name => $h, show => $a[0] || $h ) ;
            $self -> insert ( HOST, $h, $host, $num ) ;
            if ( my $a = $self -> have ( ALIA, $h ) )
              { OBB -> Die ( "host $h is an alias for $a [$num]\n" ) ; }
            for my $a ( @a )
              { if ( $self -> have ( HOST, $a ) )
                  { OBB -> Die ( "alias $a for $h is a host [$num] \n" ) ; }
                $host -> add_ali ( $a ) ;
                $self -> insert ( ALIA, $a, $h, $num ) ;
              }
          }
        elsif ( $key eq HOSTS or $key eq ITEMS )
          { my ( $g, @e ) = split ' ', $val ;
            my $set = Set -> Make ( name => $g ) ;
            $self -> insert ( $key, $g, $set, $num ) ;
            for my $e ( @e )
              { if ( $key eq HOSTS )
                  { $e = $self -> have ( ALIA, $e ) || $e ;
                    $set -> add ( $self -> find ( HOST, $e ) ) ;
                  }
                else
                  { $set -> add ( $self -> find ( ITEM, $e ) ) ; }
              }
          }
        elsif ( $key eq GET )
          { my ( $h, @v ) = split ' ', $val ;
            my $get_h  = $self -> find ( HOST, $h ) ;
            my @get_vs = () ;
            for my $v ( @v )
              { push @get_vs, $self -> find ( ITEM, $v ) ; }
            push @{ $self -> xgets }, [ $get_h, @get_vs ] ;
          }
        elsif ( $key eq HTML )
          { $self -> $key ( $val ) ; }
      }
    $self ;
  }

sub is_a_set
  { my $x = shift ; # printf "isaset (%s)\n", ref ( $x ) ;
    ref ( $x ) eq 'Set' ;
  }

sub mk_client_works
  { my $self = shift ;
    my $gets = $self -> xgets || [] ;
    my $tmp  = {} ;
    for my $get ( @$gets )
      { my ( $h, @vs ) = @$get ;
        my @hs = is_a_set ( $h ) ? $h -> flat -> list : ( $h ) ;
        $tmp -> { $_ -> name } ||= Set -> Make ( name => "gets $_" )
          for @hs ;
        for my $v ( @vs )
          { my @vars = is_a_set ( $v ) ? $v -> flat -> list : ( $v ) ;
            for my $h ( @hs )
              { $tmp -> { $h -> name } -> add ( $_ ) for @vars ; }
          }
      }
    my $res = {} ;
    for my $nam ( sort keys %$tmp )
      { my $set = $tmp -> { $nam } ;
        $res -> { $nam } { +ITEMS } = [ sort $set -> list ] ;
        my @srvs = map { $_ -> to_work } values %{ $self -> server } ;
        $res -> { $nam } { +SERVS } = [ sort @srvs ] ;
        $res -> { $nam } { +TIME  } = $^T ;
      }
    $res ;
  }

sub mk_server_works
  { my $self = shift ;
    my @srvs = map { $_ -> to_work } values %{ $self -> server } ;
    my @hsts = map { $_ -> to_work } values %{ $self -> host   } ;
    my $res  = {} ;
    for my $srv ( map { $_ -> {hnam} } @srvs )
      { $res -> { $srv } { +HOSTS } = [ @hsts ] ;
        $res -> { $srv } { +TIME  } = $^T ;
      }
    $res ;
  }

package main ;

our @META_FILES = Meta::Conf::FILES ;

my $prog = substr $0, rindex ( $0, '/' ) + 1 ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] [-f] [-h] [-w conf] [-c conf]
option v : be verbose
option q : be quiet
option d : show debug info
option f : action ; otherwise dry-run
option h : show help ; exit
option w : use work config file <conf> ;
           default [ @{[join ', ', @META_FILES]} ]
option c : use dmon config file <conf> ;
           default [ @{[join ', ', Conf::FILES]} ]
##############################################################
-- $prog uses dmon config field html.
##############################################################
USAGE
sub Usage { die "$_[0]$Usage" ; }
sub Error { die "[error] $prog: $_[0]\n" ; }
sub Warn  { warn "[warn] $prog: $_[0]\n" ; }

# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
# ID  = perl identifier
# SPC = i|f|s for integer, fixedpoint real or string argument

use Getopt::Long ;
Getopt::Long::config ( 'no_ignore_case' ) ;
my %opt = () ; Usage '' unless GetOptions
  ( \%opt, qw(v q d f h w=s c=s) ) ;
Usage("Arg count\n") unless @ARGV == 0 ;

$opt{v} ||= $opt{d} ;
OBB -> Verbosity ( 'Verbose' ) if $opt{v} ;
OBB -> Verbosity ( 'Debug'   ) if $opt{d} ;

sub save_file
  { my $file = shift ;
    my $text = shift ;
    open FILE, '>', $file or Error "can't write $file ($!)" ;
    print FILE $text ;
    close FILE ;
  }

sub save_work
  { my $prog = shift ;
    my $host = shift ;
    my $work = shift ;
    my $tmp  = $TMP_HDIR ;
    my $file = "$tmp/$prog/$host.txt" ;
    for my $d ( $tmp, "$tmp/$prog" )
      { -d $d || mkdir $d, 0755 || Error "can't mkdir $d ($!)" ; }
    my $txt = JSON::PP -> new -> utf8 -> pretty -> canonical (1)
      -> encode ( $work ) ;
    save_file $file, $txt ;
  }

sub save_works
  { my $prog = shift ;
    my $cnfs = shift ;
    for my $host ( sort keys %$cnfs )
      { save_work $prog, $host, $cnfs -> { $host } ; }
  }

sub install_works
  { my $src = shift ;
    my $dst = shift ;
    my @cmd = 'rsync';
    push @cmd, '-n' unless $opt{f} ;
    push @cmd, qw(--stats) if $opt{v} ;
    push @cmd, qw(-avzc --delete), "$src/", "$dst/" ;
    my $cmd = join ' ', @cmd ;
    if ( $opt{f} )
      { -d $dst || mkdir $dst, 0755 || Error "can't mkdir $dst ($!)" ; }
    print "syncing [$cmd] ...\n" ;
    system @cmd ;
  }

if ( $opt{h} ) { print $Usage ; exit ; }

my $dmon_conf = Conf -> Make ( file => $opt{c} ) ;

$dmon_conf -> Dmp ( 'dmon config', "\n" ) ;
$dmon_conf -> check_html ;

my $meta_conf = Meta::Conf -> Make ( file => $opt{w} ) ;

my $client_works = $meta_conf -> mk_client_works ;
printf "Using work config : %s\n\n", $meta_conf -> _file ;
print "Use '-v' to see the works.\n\n" unless $opt{v} ;
OBB::Dmp ( $client_works, 'client works' ) if $opt{v} ;
save_works Client::PROG, $client_works ;

my $server_works = $meta_conf -> mk_server_works ;
OBB::Dmp ( $server_works, 'server works' ) if $opt{v} ;
save_works Server::PROG, $server_works ;

install_works $TMP_HDIR, sprintf "%s/%s", $dmon_conf -> html, $TMP_HDIR ;

print "\nTHIS IS A DRY-RUN.\n" unless $opt{f} ;
__END__
=pod

=head1 NAME

  mk_dmon_work - distributed monitor client

=head1 SYNOPSIS

  Usage: mk_dmon_work [-v] [-q] [-d] [-f] [-h] [-w conf] [-c conf]
  option v : be verbose
  option q : be quiet
  option d : show debug info
  option f : action ; otherwise dry-run
  option h : show help ; exit
  option w : use work config file <conf> ;
             default [ work.conf, /etc/dmon/work ]
  option c : use dmon config file <conf> ;
             default [ dmon.conf, /etc/dmon/conf ]
  ##############################################################
  -- mk_dmon_work uses dmon config field html.
  ##############################################################
  

=head1 LICENSE

You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl 5.10.0 README
file.

=head1 AUTHOR

=for html mk_dmon_work &copy; 2015
<a href="http://www.staff.science.uu.nl/~penni101">Henk P. Penning</a>
- All rights reserved
; Dmon-0.03 - Tue Sep  8 13:01:09 2015

=for man Henk P. Penning, <http://www.staff.science.uu.nl/~penni101> ;

Dmon-0.03 - Tue Sep  8 13:01:09 2015


=cut