#!/usr/bin/perl

#    Copyright (c) 2007-2010 Dominique Dumont.
#
#    This file is part of Config-Model-Itself.
#
#    Config-Model is free software; you can redistribute it and/or
#    modify it under the terms of the GNU Lesser Public License as
#    published by the Free Software Foundation; either version 2.1 of
#    the License, or (at your option) any later version.
#
#    Config-Model is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#    Lesser Public License for more details.
#
#    You should have received a copy of the GNU Lesser Public License
#    along with Config-Model; if not, write to the Free Software
#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
#    02110-1301 USA

use strict ;
use warnings ;

use Config::Model;
use Getopt::Long ;
use Pod::Usage ;
use Log::Log4perl ;
use Config::Model::Itself ;
use YAML::Any;
use Tk ;
use Config::Model::TkUI ;
use Config::Model::Itself::TkEditUI ;

# lame tracing that will be replaced by Log4perl
use vars qw/$verbose $debug/ ;

$verbose = 0;
$debug = 0;

my $system_log4perl_conf_file = '/etc/log4config-model-edit.conf' ;
my $user_log4perl_conf_file = 'log4config-model-edit.conf' ;
my $fallback_conf = << 'EOC';
log4perl.logger=WARN, Screen
log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
log4perl.appender.Screen.stderr = 0
log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Screen.layout.ConversionPattern = %d %m %n
EOC

my $log4perl_conf 
    = -e $user_log4perl_conf_file   ?  $user_log4perl_conf_file 
    : -e $system_log4perl_conf_file ?  $system_log4perl_conf_file 
    :                                 \$fallback_conf ;

Log::Log4perl::init($log4perl_conf);

use lib qw/lib/ ;

my $dev_model_dir = 'lib/Config/Model/models/';
my $root_model ;
my $trace = 0 ;


=head1 NAME

config-model-edit -  Graphical model editor for Config::Model

=head1 SYNOPSIS

  config-model-edit [options] -model Sshd [ class:Sshd element:Foo ... ]

=head1 DESCRIPTION

config-model-edit will provides a Perl/Tk graphical interface to edit
configuration models that will be used by Config::Model.

Config::Model is a general purpose configuration framework based on
configuration models (See L<Config::Model> for details).

This configuration model is also expressed as structured data. This
structure data is structured and follow a set of rules which are
described for humans in L<Config::Model>.

The structure and rules documented in L<Config::Model> are also expressed
in a model in the files provided with L<Config::Model::Itself>.

Hence the possibity to verify, modify configuration data provided by
Config::Model can also be applied on configuration models using the
same user interface as L<config-edit>.

The model editor program is config-model-edit.

=head1 USAGE

By default, C<config-model-edit> will try to load a model file from
C<lib/Config/Model/models>. If no model is found, C<config-model-edit>
will try to load installed models (i.e. located in
C</usr/share/perl/...>). 

Modified models will be saved (by default) in
C<$PWD/lib/Config/Model/models/>.

You can override this behavior with option C<-dir>.

When you specify a C<-model> options, only configuration models matching
this options will be loaded. I.e.

  config-model-edit -model Xorg

will load models C<Xorg> (file C<Xorg.pl>) and all other C<Xorg::*> like
C<Xorg::Screen> (file C<Xorg/Screen.pl>).

=head1 Options

=over

=item -model

Mandatory option that specifies the configuration model to be
edited.

=item -verbose

Be (very) verbose

=item -debug

Provide debug infos.

=item -trace

Provides a full stack trace when exiting on error.

=item -force_load

Load file even if error are found in data. Bad data are discarded

=item -dot_diagram

Returns a dot file that represent the stucture of the configuration
model. C<include> are represented by solid lines. Class usage
(i.e. C<config_class_name> parameter) is represented by dashed
lines. The name of the element is attached to the dashed line.

=item -dump [ file ]

Dump configuration content on STDOUT or in the specified with
Config::Model syntax.

By default, dump only custom values, i.e. different from application
built-in values or model default values. See -dumptype option for
other types of dump

=item -dumptype [ full | preset | custom ]

Choose to dump every values (full), only preset values or only
customized values (default)

=item -load <cds_file_to_load> | -

Load model from cds file (using Config::Model serialisation format,
typically done with -dump option). This option can be used with
C<-save> to directly save a model loaded from the cds file or from
STDIN.

=item -load_yaml <yaml_file_to_load> | -

Load configuration data in model from cds file (using Config::Model
serialisation format, typically done with -dump_yaml option). This
option can be used with C<-save> to directly save a model loaded from
the YAML file or from STDIN.

=item -save

Force a save of the model even if no edition was done. This option is
useful to migrate a model when Config::Model model feature changes.

=item -model_dir

Directory where to read and write model

=back


=cut

sub load_data {
    my $load_file = shift ;

    my @data ;
    if ( $load_file eq '-' ) {
	@data = <STDIN> ;
    }
    else {
	open(LOAD,$load_file) || die "cannot open load file $load_file:$!";
	@data = <LOAD> ;
	close LOAD; 
    }

    return wantarray ? @data : join('',@data);
}

my $man = 0;
my $help = 0;
my $force_load = 0;
my $model_dir ;
my $do_dot = 0;
my $do_dump;
my $dumptype;
my $do_yaml = 0;
my $load_yaml ;
my $save = 0;
my $load ;
my $model_modified = 0;

my $result = GetOptions (
			 "dir=s"            => \$model_dir,
			 "model=s"          => \$root_model,
			 "verbose!"         => \$verbose,
			 "debug!"           => \$debug,
			 "trace!"           => \$trace,
			 "man!"             => \$man,
			 "help!"            => \$help,
			 "force_load!"      => \$force_load,
			 "save!"            => \$save,
			 "dot_diagram!"     => \$do_dot ,
			 "dump!"            => \$do_dump ,
                         "dumptype:s"       => \$dumptype,
                         "load=s"           => \$load,
                         "load_yaml=s"      => \$load_yaml,
			 "dump_yaml!"       => \$do_yaml ,
			);

pod2usage(2) if not $result ;
pod2usage(1) if $help;
pod2usage(-verbose => 2) if $man;

Config::Model::Exception::Any->Trace(1) if $trace ;

die "Unspecified root configuration model (option -model)\n"
  unless defined $root_model ;

my $wr_model_dir = $model_dir || $dev_model_dir ;

if (! -d $wr_model_dir) {
    mkdir $wr_model_dir, 0755 || die "can't create $wr_model_dir:$!";
}

my $meta_model = Config::Model -> new();

my $meta_inst 
  = $meta_model->instance (root_class_name => 'Itself::Model' ,
			   instance_name   => $root_model.' model' ,
			   force_load      => $force_load,
			  );

my $meta_root = $meta_inst -> config_root ;

# now load model

my $rw_obj = Config::Model::Itself -> new(model_object => $meta_root ) ;

my $read_model_dir = $model_dir || $dev_model_dir ;

if (not -e $read_model_dir.'/'.$root_model.'.pl') {
    $read_model_dir =  $INC{'Config/Model.pm'} ;
    $read_model_dir =~ s/\.pm//;
    $read_model_dir .= '/models' ;
}

$rw_obj -> read_all( model_dir  => $read_model_dir, 
		     force_load => $force_load ,
		     root_model => $root_model,
		     legacy =>'ignore',
		   ) ;

$meta_inst->push_no_value_check(qw/store type/) if $force_load ;

if (defined $load) {
    my $data = load_data($load) ;
    $meta_root->load($data);
    $model_modified = 1;
}

if (defined $load_yaml) {
    my $yaml = load_data($load_yaml) ;
    my $pdata = Load($yaml) ;
    $meta_root->load_data($pdata) ;
    $model_modified = 1;
}

if (@ARGV) {
    $meta_root->load("@ARGV") ;
    $model_modified = 1;
}

$meta_inst->pop_no_value_check() if $force_load ;


if ($do_dot) {
    print $rw_obj->get_dot_diagram ;
    exit ;
}

if (defined $do_dump) {
    my $dump_string = $meta_root->dump_tree( mode => $dumptype || 'custom' ) ;
    if ($do_dump) {
	open(DUMP,">$do_dump") or die "cannot dump in $do_dump:$!";
	print DUMP $dump_string ;
	close DUMP;
    }
    else {
	print $dump_string ;
    }
    exit ;
}

if ($do_yaml) {
    require YAML::Tiny;
    import YAML::Tiny qw/Dump/;
    print Dump($meta_root->dump_as_data(ordered_hash_as_list => 0)) ;
    exit ;
}

my $write_sub = sub { 
    my $wr_dir = shift || $wr_model_dir ;
    $rw_obj->write_all(model_dir => $wr_dir);
} ;

if ($save) {
    &$write_sub ;
    exit ;
}

my $mw = MainWindow-> new ;
$mw->withdraw ;
# Thanks to Jerome Quelin for the tip
$mw->optionAdd('*BorderWidth' => 1);

$model_modified = 1 if $wr_model_dir ne $read_model_dir ;


my $cmu = $mw->ConfigModelEditUI (-root      => $meta_root,
				  -store_sub => $write_sub,
  				  -model_dir => $wr_model_dir,
				  -model_name => $root_model,
				  -model_modified => $model_modified,
				 ) ;

&MainLoop ; # Tk's

=head1 LOGGING

All Config::Model logging is (slowly) moved from klunky debug and
verbose prints to L<Log::Log4perl>. Logging can be configured in the
following files:

=over

=item *

 ~/.log4config-model

=item * 

 /etc/log4config-model.conf

=back

Without these files, the following Log4perl config is used:

 log4perl.logger=WARN, Screen
 log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
 log4perl.appender.Screen.stderr = 0
 log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
 log4perl.appender.Screen.layout.ConversionPattern = %d %m %n

Log4Perl categories are shown in L<config-edit/LOGGING>

=head1 AUTHOR

Dominique Dumont, ddumont at cpan dot org

=head1 SEE ALSO

L<Config::Model>, 
L<Config::Model::Node>, 
L<Config::Model::Instance>, 
L<Config::Model::HashId>,
L<Config::Model::ListId>,
L<Config::Model::WarpedNode>,
L<Config::Model::Value>

=cut