#!/usr/bin/perl
#
# This file is part of Config-Model-Itself
#
# This software is Copyright (c) 2013 by Dominique Dumont.
#
# This is free software, licensed under:
#
# The GNU Lesser General Public License, Version 2.1, February 1999
#
use strict ;
use warnings ;
use Config::Model;
use Getopt::Long ;
use Pod::Usage ;
use Log::Log4perl ;
use Config::Model::Itself ;
use YAML::Any;
use AnyEvent ;
require AnyEvent::Impl::Tk ;
use Tk ;
use Config::Model::TkUI ;
use Config::Model::Itself::TkEditUI ;
use Path::Class ;
use lib qw/lib/ ;
my $log4perl_syst_conf_file = '/etc/log4config-model.conf' ;
my $log4perl_user_conf_file = $ENV{HOME}.'/.log4config-model' ;
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 $log4perl_user_conf_file ? $log4perl_user_conf_file
: -e $log4perl_syst_conf_file ? $log4perl_syst_conf_file
: \$fallback_conf ;
Log::Log4perl::init($log4perl_conf);
my $dev_model_dir = dir(qw/lib Config Model models/);
my $root_model ;
my $trace = 0 ;
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_path ;
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 $open_item = '';
my $plugin_file = '';
my $result = GetOptions (
"dir=s" => \$model_dir_path,
"model=s" => \$root_model,
"man!" => \$man,
"help!" => \$help,
"force-load|force_load!" => \$force_load,
"save!" => \$save,
"dot-diagram|dot_diagram!" => \$do_dot ,
"dump!" => \$do_dump ,
"dumptype:s" => \$dumptype,
"load=s" => \$load,
"load-yaml|load_yaml=s" => \$load_yaml,
"dump-yaml|dump_yaml!" => \$do_yaml ,
"open-item|open_item=s" => \$open_item ,
"plugin-file=s" => \$plugin_file ,
);
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 $model_dir = $model_dir_path ? dir(split m!/!, $model_dir_path) : $dev_model_dir ;
if (! -d $model_dir->stat) {
$model_dir->mkpath(0, 0755) || die "can't create $model_dir:$!";
}
my $meta_model = Config::Model -> new();
my $meta_inst = $meta_model->instance(
root_class_name => 'Itself::Model',
instance_name => $root_model . ' model',
check => $force_load ? 'no' : 'yes',
);
my $meta_root = $meta_inst -> config_root ;
my $system_model_dir = $INC{'Config/Model.pm'} ;
$system_model_dir =~ s/\.pm//;
$system_model_dir .= '/models' ;
# now load model
my $rw_obj = Config::Model::Itself -> new(
model_object => $meta_root,
model_dir => $plugin_file ? $system_model_dir : $model_dir->stringify,
) ;
# my $root_model_file = $root_model ;
# $root_model_file =~ s!::!/!g ;
# if (not -e $read_model_dir.'/'.$root_model_file.'.pl') {
# $read_model_dir = $INC{'Config/Model.pm'} ;
# $read_model_dir =~ s/\.pm//;
# $read_model_dir .= '/models' ;
# }
$meta_inst->initial_load_start ;
$meta_inst->layered_start if $plugin_file;
$rw_obj->read_all(
force_load => $force_load,
root_model => $root_model,
# legacy => 'ignore',
);
if ($plugin_file) {
$meta_inst->layered_stop;
# load any existing plugin file
$rw_obj->read_model_snippet(snippet_dir => $model_dir, model_file => $plugin_file) ;
}
$meta_inst->initial_load_stop ;
if (defined $load) {
my $data = load_data($load) ;
$data = qq(class:"$root_model" ).$data unless $data =~ /^\s*class:/ ;
$meta_root->load($data);
}
if (defined $load_yaml) {
my $yaml = load_data($load_yaml) ;
my $pdata = Load($yaml) ;
$meta_root->load_data($pdata) ;
}
if (@ARGV) {
my $data = join(' ',@ARGV) ;
$data = qq(class:"$root_model" ).$data unless $data =~ /^\s*class:/ ;
$meta_root->load($data) ;
}
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 = $plugin_file ?
sub {
$rw_obj->write_model_snippet(snippet_dir => $model_dir, model_file => $plugin_file );
}
: sub {
my $wr_dir = shift || $model_dir ;
$rw_obj->write_all( );
} ;
if ($save) {
&$write_sub ;
exit ;
}
my $mw ;
{
no warnings 'once' ;
$mw = $AnyEvent::Impl::Tk::mw ;
}
$mw->withdraw ;
# Thanks to Jerome Quelin for the tip
$mw->optionAdd('*BorderWidth' => 1);
my $cmu = $mw->ConfigModelEditUI(
-root => $meta_root,
-store_sub => $write_sub,
-model_name => $root_model,
);
if ($open_item) {
my $obj = $meta_root->grab($open_item) ;
$cmu->force_element_display($obj) ;
}
&MainLoop ; # Tk's
__END__
=pod
=head1 NAME
config-model-edit - Graphical model editor for Config::Model
=head1 SYNOPSIS
config-model-edit [options] -model Sshd [ class:Sshd element:Foo ... ]
# plugin mode
config-model-edit [options] -model Debian::Dpkg -plugin-file dpkg-snippet.pl
=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
C<config-model-edit> will read and write model file from
C<./lib/Config/Model/models>.
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 -plugin-file foo.pl
this option can be used to create model plugins. A model plugin is an addendum to
an existing model. The resulting file will be saved in a C<.d> directory besides the
original file to be taken into account.
For instance:
$ config-model-edit -model Debian::Dpkg -plugin-file my-plugin.pl
# perform additions to Debian::Dpkg and Debian::Dpkg::Control::Source and save
$ find lib -name my-plugin.pl
lib/Config/Model/models/Debian/Dpkg.d/my-plugin.pl
lib/Config/Model/models/Debian/Dpkg/Control/Source.d/my-plugin.pl
=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 loaded, but should be cleaned up
before saving the model. See menu C<< File -> check >> in the GUI.
=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 YAML file. This
option can be used with C<-save> to directly save a model loaded from
the YAML file or from STDIN.
=item -dump_yaml
Dump a model in YAML format
=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 -dir
Directory where to read and write model
=item -open-item 'path'
In graphical mode, force the UI to open the node specified. E.g.
-open_item 'class:Fstab::FsLine element:fs_mntopts rules'
=back
=head1 LOGGING
All Config::Model logging was 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