r33644 - in /branches/upstream/libconfig-model-itself-perl/current: ./ data/ data/MasterModel/ lib/Config/Model/ lib/Config/Model/models/Itself/ t/

ddumont-guest at users.alioth.debian.org ddumont-guest at users.alioth.debian.org
Tue Apr 21 12:06:28 UTC 2009


Author: ddumont-guest
Date: Tue Apr 21 12:06:21 2009
New Revision: 33644

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=33644
Log:
[svn-upgrade] Integrating new upstream version, libconfig-model-itself-perl (1.210)

Added:
    branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/References.pl
    branches/upstream/libconfig-model-itself-perl/current/t/dot_graph.t
Modified:
    branches/upstream/libconfig-model-itself-perl/current/Build.PL
    branches/upstream/libconfig-model-itself-perl/current/ChangeLog
    branches/upstream/libconfig-model-itself-perl/current/MANIFEST
    branches/upstream/libconfig-model-itself-perl/current/META.yml
    branches/upstream/libconfig-model-itself-perl/current/config-model-edit
    branches/upstream/libconfig-model-itself-perl/current/data/MasterModel.pl
    branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/SshdWithAugeas.pl
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/Itself.pm
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoElement.pl
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoWarpRule.pl
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Class.pl
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CommonElement.pl
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Element.pl
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpOnlyElement.pl
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableCargoElement.pl
    branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableElement.pl
    branches/upstream/libconfig-model-itself-perl/current/t/itself-editor.t
    branches/upstream/libconfig-model-itself-perl/current/t/itself.t

Modified: branches/upstream/libconfig-model-itself-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/Build.PL?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/Build.PL (original)
+++ branches/upstream/libconfig-model-itself-perl/current/Build.PL Tue Apr 21 12:06:21 2009
@@ -2,7 +2,7 @@
 # $Date: 2008-02-07 11:29:57 $
 # $Revision: 1.3 $
 
-#    Copyright (c) 2007-2008 Dominique Dumont.
+#    Copyright (c) 2007-2009 Dominique Dumont.
 #
 #    This file is part of Config-Model-Itself.
 #
@@ -35,7 +35,7 @@
    dist_author   => "Dominique Dumont (ddumont at cpan dot org)",
    dist_abstract => "Graphical model editor for Config::Model",
    requires      => {
-		     'Config::Model'   => '0.634',
+		     'Config::Model'   => '0.635',
 		     'Log::Log4perl'   => 0 ,
 		     'Config::Model::TkUI' => '1.203',
 		    },

Modified: branches/upstream/libconfig-model-itself-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/ChangeLog?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/ChangeLog (original)
+++ branches/upstream/libconfig-model-itself-perl/current/ChangeLog Tue Apr 21 12:06:21 2009
@@ -1,3 +1,36 @@
+2009-04-20  Dominique Dumont  <dominique.dumont at hp.com> v1.210
+
+	* config-model-edit: Fixed Log::Log4perl default configuration
+
+2009-04-12  Dominique Dumont  <domi.dumont at free.fr>
+
+	* lib/Config/Model/models/Itself/Class.pl: Added auto_create and
+	file parameter to read/write spec (Req by Config::Model
+	0.635). Parameter allow_empty is deprecated and will be replaced
+	by auto_create when you run config-edit-model
+
+2009-04-03  Dominique Dumont  <dominique.dumont at hp.com> 
+
+	* config-model-edit: new -dot_diagram option to get a dot file to
+	reprensent the structure of the configuration model
+
+	* lib/Config/Model/Iself.pm (get_dot_diagram): New method to draw a
+	diagram of the configuration class with "include" and
+	usage (e.g. with "config_class_name" parameter).
+
+	* lib/Config/Model/models/Itself/Element.pl: index_type is now
+	mandatory for hash types
+
+2009-03-30  Dominique Dumont  <dominique.dumont at hp.com>
+
+	* lib/Config/Model/models/Itself/Element.pl: Added summary model
+	parameter (Config::Model 0.635)
+
+2009-03-12  Dominique Dumont  <dominique.dumont at hp.com>
+
+	* lib/Config/Model/models/Itself/CommonElement.pl: 'choice' is
+	also available for 'reference' values
+
 2009-03-10  Dominique Dumont  <dominique.dumont at hp.com>  v1.209
 
 	* t/*.t: Backported mkpath calls to File::Path delivered by perl

Modified: branches/upstream/libconfig-model-itself-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/MANIFEST?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/MANIFEST (original)
+++ branches/upstream/libconfig-model-itself-perl/current/MANIFEST Tue Apr 21 12:06:21 2009
@@ -11,6 +11,7 @@
 data/MasterModel/WarpedId.pl
 data/MasterModel/WarpedValues.pl
 data/MasterModel/SshdWithAugeas.pl
+data/MasterModel/References.pl
 data/MasterModel/X_base_class.pl
 lib/Config/Model/Itself.pm
 lib/Config/Model/Itself/TkEditUI.pm
@@ -29,6 +30,7 @@
 lib/Config/Model/models/Itself/WarpValue.pl
 lib/Config/Model/models/Itself/WarpableCargoElement.pl
 lib/Config/Model/models/Itself/WarpableElement.pl
+t/dot_graph.t
 t/itself.t
 t/itself-editor.t
 t/list_itself_structure.t

Modified: branches/upstream/libconfig-model-itself-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/META.yml?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/META.yml (original)
+++ branches/upstream/libconfig-model-itself-perl/current/META.yml Tue Apr 21 12:06:21 2009
@@ -1,6 +1,6 @@
 ---
 name: Config-Model-Itself
-version: 1.209
+version: 1.210
 author:
   - Dominique Dumont (ddumont at cpan dot org)
 abstract: Graphical model editor for Config::Model
@@ -8,13 +8,13 @@
 resources:
   license: http://opensource.org/licenses/lgpl-license.php
 requires:
-  Config::Model: 0.634
+  Config::Model: 0.635
   Config::Model::TkUI: 1.203
   Log::Log4perl: 0
 provides:
   Config::Model::Itself:
     file: lib/Config/Model/Itself.pm
-    version: 1.209
+    version: 1.210
   Config::Model::Itself::TkEditUI:
     file: lib/Config/Model/Itself/TkEditUI.pm
     version: 1.0615

Modified: branches/upstream/libconfig-model-itself-perl/current/config-model-edit
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/config-model-edit?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/config-model-edit (original)
+++ branches/upstream/libconfig-model-itself-perl/current/config-model-edit Tue Apr 21 12:06:21 2009
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-#    Copyright (c) 2007-2008 Dominique Dumont.
+#    Copyright (c) 2007-2009 Dominique Dumont.
 #
 #    This file is part of Config-Model-Itself.
 #
@@ -34,7 +34,7 @@
 # lame tracing that will be replaced by Log4perl
 use vars qw/$verbose $debug $VERSION/ ;
 
-$VERSION = sprintf "1.%04d", q$Revision: 841 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 942 $ =~ /(\d+)/;
 
 $verbose = 0;
 $debug = 0;
@@ -42,16 +42,16 @@
 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.ConfigModel=WARN, A1
-log4perl.appender.A1=Log::Dispatch::File
-log4perl.appender.A1.filename=/tmp/ConfigModel.log
-log4perl.appender.A1.mode=append
-log4perl.appender.A1.layout=Log::Log4perl::Layout::SimpleLayout
+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 
+    = -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);
@@ -127,24 +127,6 @@
 will look for C</etc/config-model.d/Fstab.pl> model file. See
 L<Config::Model> for more details.
 
-=item -if
-
-Specify the user interface type. 
-
-=over
-
-=item *
-
-C<shell>: provides a shell like interface.  See L<Config::Model::TermUI>
-for details.
-
-=item *
-
-C<curses>: provides a curses user interface (If
-Config::Model::CursesUI is installed).
-
-=back
-
 =item -verbose
 
 Be (very) verbose
@@ -160,6 +142,13 @@
 =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.
 
 =back
 
@@ -170,6 +159,7 @@
 my $help = 0;
 my $force_load = 0;
 my $model_dir ;
+my $do_dot = 0;
 
 my $result = GetOptions (
 			 "dir=s"            => \$model_dir,
@@ -180,6 +170,7 @@
 			 "man!"             => \$man,
 			 "help!"            => \$help,
 			 "force_load!"      => \$force_load,
+			 "dot_diagram!"     => \$do_dot ,
 			);
 
 pod2usage(2) if not $result ;
@@ -221,7 +212,14 @@
 
 $rw_obj -> read_all( model_dir  => $read_model_dir, 
 		     force_load => $force_load ,
-		     root_model => $root_model ) ;
+		     root_model => $root_model,
+		     legacy =>'ignore',
+		   ) ;
+
+if ($do_dot) {
+    print $rw_obj->get_dot_diagram ;
+    exit ;
+}
 
 my $write_sub = sub { 
     my $wr_dir = shift || $wr_model_dir ;

Modified: branches/upstream/libconfig-model-itself-perl/current/data/MasterModel.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/data/MasterModel.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/data/MasterModel.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/data/MasterModel.pl Tue Apr 21 12:06:21 2009
@@ -81,9 +81,9 @@
    level      => [ [qw/hash_a tree_macro int_v/] => 'important' ],
 
    read_config  =>  { backend => 'cds_file',  config_dir  => 'conf_data',
-		      allow_empty => 1 
+		      auto_create => 1,
 		    },
-   write_config => [{ backend => 'cds_file',  config_dir  => 'conf_data'},
+   write_config => [{ backend => 'cds_file',  config_dir  => 'conf_data', file => 'mymaster.cds' },
 		    { backend => 'perl_file', config_dir  => 'conf_data'}],
 
    element => [
@@ -118,6 +118,7 @@
 	       tree_macro => { type => 'leaf',
 			       value_type => 'enum',
 			       choice     => [qw/XY XZ mXY/],
+			       summary => 'macro parameter for tree',
 			       help => { XY  => 'XY help',
 					 XZ  => 'XZ help',
 					 mXY => 'mXY help',
@@ -216,6 +217,11 @@
 				      use_eval => 1 ,
 				    },
 		  },
+	       'reference_stuff' 
+	       => {
+	            type => 'node',
+	            config_class_name => 'MasterModel::References',
+	          },
 	       ## too difficult to correctly test Augeas here
 	       'sshd_augeas' 
 	       => {

Added: branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/References.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/References.pl?rev=33644&op=file
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/References.pl (added)
+++ branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/References.pl Tue Apr 21 12:06:21 2009
@@ -1,0 +1,86 @@
+[
+ [
+  name => 'MasterModel::References::Host',
+  'element' => [ 
+		if => { type => 'hash',
+			index_type => 'string',
+			cargo_type => 'node',
+			config_class_name  => 'MasterModel::References::If',
+		      },
+		trap => { type => 'leaf',
+			  value_type => 'string'
+			}
+	       ]
+ ],
+ [
+  name => 'MasterModel::References::If',
+  element => [
+	      ip => { type => 'leaf',
+		      value_type => 'string'
+		    }
+	     ]
+ ],
+ [
+  name => 'MasterModel::References::Lan',
+  element => [
+	      node => { type => 'hash',
+			index_type => 'string',
+			cargo_type => 'node',
+			config_class_name  => 'MasterModel::References::Node',
+		      },
+	     ]
+ ],
+ [
+  name => 'MasterModel::References::Node',
+  element => [
+	      host => { type => 'leaf',
+			value_type => 'reference' ,
+			refer_to => '- host'
+		      },
+	      if   => { type => 'leaf',
+			value_type => 'reference' ,
+			refer_to => [ '  - host:$h if ', h => '- host' ]
+		      },
+	      ip => { type => 'leaf',
+		      value_type => 'string',
+		      compute    => [
+				     '$ip',
+				     ip   => '- host:$h if:$card ip',
+				     h    => '- host',
+				     card => '- if'
+				    ]
+		    }
+	     ]
+ ],
+ [
+  name => 'MasterModel::References',
+  element => [
+	      host => { type => 'hash',
+			index_type => 'string',
+			cargo_type => 'node',
+			config_class_name  => 'MasterModel::References::Host'
+		      },
+	      lan => { type => 'hash',
+		       index_type => 'string',
+		       cargo_type => 'node',
+		       config_class_name  => 'MasterModel::References::Lan'
+		     },
+	      host_and_choice => { type => 'leaf',
+				   value_type => 'reference' ,
+				   refer_to => [ '- host ' ],
+				   choice => [qw/foo bar/]
+				 },
+	      dumb_list => { type => 'list',
+			     cargo_type => 'leaf',
+			     cargo_args => {value_type => 'string'}
+			   },
+	      refer_to_list_enum 
+	      => {
+		  type => 'leaf',
+		  value_type => 'reference',
+		  refer_to => '- dumb_list',
+		 },
+
+	     ]
+ ]
+];

Modified: branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/SshdWithAugeas.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/SshdWithAugeas.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/SshdWithAugeas.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/data/MasterModel/SshdWithAugeas.pl Tue Apr 21 12:06:21 2009
@@ -11,7 +11,7 @@
       },
       { backend => 'perl_file', 
 	config_dir  => '/etc/ssh',
-	allow_empty => 1,
+	auto_create => 1,
       },
      ],
 

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/Itself.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/Itself.pm?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/Itself.pm (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/Itself.pm Tue Apr 21 12:06:21 2009
@@ -1,6 +1,6 @@
 # $Author: ddumont $
-# $Date: 2009-03-10 12:57:46 +0100 (Tue, 10 Mar 2009) $
-# $Revision: 877 $
+# $Date: 2009-04-06 13:57:55 +0200 (Mon, 06 Apr 2009) $
+# $Revision: 919 $
 
 #    Copyright (c) 2007-2009 Dominique Dumont.
 #
@@ -34,7 +34,7 @@
 
 use vars qw($VERSION) ;
 
-$VERSION = '1.209';
+$VERSION = '1.210';
 
 my $logger = Log::Log4perl::get_logger(__PACKAGE__);
 
@@ -188,7 +188,7 @@
 	    # no need to dclone model as Config::Model object is temporary
 	    my $new_model =  $tmp_model -> get_model( $model_name ) ;
 
-	    foreach my $item (qw/description level experience status/) {
+	    foreach my $item (qw/description summary level experience status/) {
 		foreach my $elt_name (keys %{$new_model->{element}}) {
 		    my $moved_data = delete $new_model->{$item}{$elt_name}  ;
 		    next unless defined $moved_data ;
@@ -395,6 +395,93 @@
     return $res ;
 }
 
+=head2 get_dot_diagram
+
+Returns a graphviz dot file that represents the strcuture of the
+configuration model:
+
+=over
+
+=item *
+
+C<include> are represented by solid lines
+
+=item *
+
+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.
+
+=back
+
+=cut
+
+sub get_dot_diagram {
+    my $self = shift ;
+    my $dot = "digraph model {\n" ;
+
+    my $meta_class = $self->{model_object}->fetch_element('class') ;
+    foreach my $class_name ($meta_class->get_all_indexes ) {
+	my $c_model = $self->{model_object}->config_model->get_raw_model($class_name);
+	my $elts = $c_model->{element} || []; # array ref
+
+	my $d_class = $class_name ;
+	$d_class =~ s/::/__/g;
+
+	my $elt_list = '';
+	my $use = '';
+	for (my $idx = 0; $idx < @$elts; $idx += 2) {
+	    my $elt_info = $elts->[$idx] ;
+	    my @elt_names = ref $elt_info ? @$elt_info : ($elt_info) ;
+	    my $type = $elts->[$idx+1]{type} ;
+
+	    foreach my $elt_name (@elt_names) {
+		$elt_list .= "- $elt_name ($type)\\n";
+		$use .= $self->scan_used_class($d_class,$elt_name,
+					       $elts->[$idx+1]);
+	    }
+	}
+
+	$dot .= $d_class 
+             .  qq! [shape=box label="$class_name\\n$elt_list"];\n!
+	     .  $use . "\n";
+
+	my $include = $c_model->{include} ;
+	if (defined $include) {
+	    my $inc_ref = ref $include ? $include : [ $include ] ;
+	    foreach my $t (@$inc_ref) {
+		$t =~ s/::/__/g;
+		$dot.= qq!$d_class -> $t ;\n!;
+	    }
+	}
+    }
+
+    $dot .="}\n";
+
+    return $dot ;
+}
+
+sub scan_used_class {
+    my ($self,$d_class,$elt_name,$ref) = @_ ;
+    my $res = '' ;
+
+    if (ref($ref) eq 'HASH') {
+	foreach my $k (keys %$ref) {
+	    my $v = $ref->{$k} ;
+	    if ($k eq 'config_class_name') {
+		$v =~ s/::/__/g;
+		$res .= qq!$d_class -> $v !
+		      . qq![ style=dashed, label="$elt_name" ];\n!;
+	    }
+	    if (ref $v) {
+		$res .= $self->scan_used_class($d_class,$elt_name,$v);
+	    }
+	}
+    }
+    elsif (ref($ref) eq 'ARRAY') {
+	map {$res .= $self->scan_used_class($d_class,$elt_name,$_);} @$ref ;
+    }
+    return $res ;
+}
 
 1;
 

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoElement.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoElement.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoElement.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoElement.pl Tue Apr 21 12:06:21 2009
@@ -1,6 +1,6 @@
 # $Author: ddumont $
-# $Date: 2008-04-16 17:58:48 +0200 (Wed, 16 Apr 2008) $
-# $Revision: 612 $
+# $Date: 2009-04-03 17:50:41 +0200 (Fri, 03 Apr 2009) $
+# $Revision: 916 $
 
 #    Copyright (c) 2007-2008 Dominique Dumont.
 #
@@ -47,7 +47,7 @@
 	    follow => { elt_type => '- type' } ,
 
 	    rules  => [
-		       '$elt_type ne "node"' =>
+		       '$elt_type ne "warped_node"' =>
 		       {
 			level => 'normal',
 			config_class_name => 'Itself::CargoWarpValue',

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoWarpRule.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoWarpRule.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoWarpRule.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CargoWarpRule.pl Tue Apr 21 12:06:21 2009
@@ -24,7 +24,7 @@
   [
    name => "Itself::CargoWarpRule",
 
-   class_description => 'Specify one condition and one effect to be applied on the warped object (used for cargo of a hashor list element)',
+   class_description => 'Specify one condition and one effect to be applied on the warped object (used for cargo of a hash or list element)',
 
    'element' 
    => [

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Class.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Class.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Class.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Class.pl Tue Apr 21 12:06:21 2009
@@ -1,6 +1,6 @@
 # $Author: ddumont $
-# $Date: 2009-01-01 21:48:41 +0100 (Thu, 01 Jan 2009) $
-# $Revision: 821 $
+# $Date: 2009-04-12 19:43:01 +0200 (Sun, 12 Apr 2009) $
+# $Revision: 928 $
 
 #    Copyright (c) 2007-2008 Dominique Dumont.
 #
@@ -131,6 +131,15 @@
 			      }
 		    },
 
+       'file'
+       => {
+	   type => 'leaf',
+	   value_type => 'uniline' ,
+	   level => 'normal',
+	   summary =>  'target configuration file name',
+	   description => 'specify the configuration file name. This parameter may not be applicable depending on your application. It may also be hardcoded in a custom backend. If not specified, the instance name will be used as base name for your configuration file.', 
+	  },
+
        'class'
        => {
 	   type => 'leaf',
@@ -229,12 +238,26 @@
 			   }
 	  },
 
+       'auto_create'
+       => {
+	   type => 'leaf',
+	   value_type => 'boolean' ,
+	   level => 'normal',
+	   built_in => 0,
+	   summary => 'Creates configuration files as needed',
+	   migrate_from => { formula => '$old' ,
+			     variables => { old => '- allow_empty' } ,
+			   },
+	  },
+
        'allow_empty'
        => {
 	   type => 'leaf',
 	   value_type => 'boolean' ,
 	   level => 'normal',
+	   status => 'deprecated',
 	   built_in => 0,
+	   summary => 'deprecated in favor of auto_create',
 	  },
 
        ],
@@ -269,6 +292,17 @@
 			    variables => { old => '- - write_config_dir' } ,
 			   }
 	  },
+
+       # move to ConfigRW when removing legacy allow_empty
+       'auto_create'
+       => {
+	   type => 'leaf',
+	   value_type => 'boolean' ,
+	   level => 'normal',
+	   built_in => 0,
+	   summary => 'Creates configuration files as needed',
+	  },
+
       ],
   ],
 

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CommonElement.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CommonElement.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CommonElement.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/CommonElement.pl Tue Apr 21 12:06:21 2009
@@ -80,8 +80,10 @@
 				 vt => '?value_type',
 			       },
 		     'rules'
-		     => [ '  ($t eq "leaf" and $vt eq "enum" )
-                            or $t eq "check_list"' 
+		     => [ '  ($t eq "leaf" and (   $vt eq "enum" 
+                                                or $vt eq "reference")
+                             )
+                           or $t eq "check_list"' 
 			  => {
 			      level => 'normal',
 			     } ,
@@ -202,22 +204,6 @@
 
       # hash element
 
-      'index_type' 
-      => { type => 'leaf',
-	   value_type => 'enum',
-	   level      => 'hidden' ,
-	   warp => { follow => '?type',
-		     'rules'
-		     => { 'hash' => {
-				     level => 'important',
-				     #mandatory => 1,
-				     choice => [qw/string integer/] ,
-				    }
-			}
-		   },
-	   description => 'Specify the type of allowed index for the hash. "String" means no restriction.',
-	 },
-
       # list element
 
 

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Element.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Element.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Element.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/Element.pl Tue Apr 21 12:06:21 2009
@@ -1,6 +1,6 @@
 # $Author: ddumont $
-# $Date: 2008-05-01 16:41:22 +0200 (Thu, 01 May 2008) $
-# $Revision: 641 $
+# $Date: 2009-04-03 17:50:41 +0200 (Fri, 03 Apr 2009) $
+# $Revision: 916 $
 
 #    Copyright (c) 2007-2008 Dominique Dumont.
 #
@@ -66,11 +66,18 @@
 	   description => 'Used to highlight important parameter or to hide others. Hidden parameter are mostly used to hide features that are unavailable at start time. They can be made available later using warp mechanism',
 	  },
 
+      'summary' 
+      => {
+	  type => 'leaf',
+	  value_type => 'uniline', 
+	  description => 'enter short information regarding this element',
+	 },
+
       'description' 
       => {
 	  type => 'leaf',
 	  value_type => 'string', 
-	  description => 'enter help information regarding this element',
+	  description => 'enter detailed help information regarding this element',
 	 },
 
       # all but warped_node
@@ -111,6 +118,22 @@
 		  description => "Each key of a hash is a boolean expression using variables declared in the 'follow' parameters. The value of the hash specifies the effects on the node",
 		 },
       # hash or list
+      'index_type' 
+      => { type => 'leaf',
+	   value_type => 'enum',
+	   level      => 'hidden' ,
+	   warp => { follow => '?type',
+		     'rules'
+		     => { 'hash' => {
+				     level => 'important',
+				     mandatory => 1,
+				     choice => [qw/string integer/] ,
+				    }
+			}
+		   },
+	   description => 'Specify the type of allowed index for the hash. "String" means no restriction.',
+	 },
+
       'cargo' 
       => { type => 'warped_node',
 	   level => 'hidden',
@@ -123,6 +146,7 @@
 		      ],
 	   description => 'Specify the properties of the configuration element configuration in this hash or list',
 	 },
+
      ],
  ],
 ];

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpOnlyElement.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpOnlyElement.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpOnlyElement.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpOnlyElement.pl Tue Apr 21 12:06:21 2009
@@ -43,6 +43,22 @@
 	   choice => [qw/important normal hidden/] ,
 	  },
 
+      'index_type' 
+      => { type => 'leaf',
+	   value_type => 'enum',
+	   level      => 'hidden' ,
+	   warp => { follow => '?type',
+		     'rules'
+		     => { 'hash' => {
+				     level => 'important',
+				     #mandatory => 1,
+				     choice => [qw/string integer/] ,
+				    }
+			}
+		   },
+	   description => 'Specify the type of allowed index for the hash. "String" means no restriction.',
+	 },
+
       ],
 
    'description' 

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableCargoElement.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableCargoElement.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableCargoElement.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableCargoElement.pl Tue Apr 21 12:06:21 2009
@@ -26,6 +26,7 @@
 
    include => 'Itself::CommonElement' ,
 
+   class_description => 'attributes that can be warped within cargo of a hash or list element',
   ],
 
 ];

Modified: branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableElement.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableElement.pl?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableElement.pl (original)
+++ branches/upstream/libconfig-model-itself-perl/current/lib/Config/Model/models/Itself/WarpableElement.pl Tue Apr 21 12:06:21 2009
@@ -1,6 +1,6 @@
 # $Author: ddumont $
-# $Date: 2009-02-24 13:08:18 +0100 (Tue, 24 Feb 2009) $
-# $Revision: 861 $
+# $Date: 2009-03-12 17:45:52 +0100 (Thu, 12 Mar 2009) $
+# $Revision: 895 $
 
 #    Copyright (c) 2007-2008 Dominique Dumont.
 #
@@ -152,7 +152,6 @@
        allow_keys => 'specify a set of allowed keys',
        default_with_init => 'specify a set of keys to create and initialization on some elements . E.g. \' foo => "X=Av Y=Bv", bar => "Y=Av Z=Cz"\' ',
        convert => 'When stored, the value will be converted to uppercase (uc) or lowercase (lc).',
-       choice => 'Specify the possible values',
        help => 'Specify help string specific to possible values. E.g for "light" value, you could write " red => \'stop\', green => \'walk\' ',
        replace => 'Used for enum to substitute one value with another. This parameter must be used to enable user to upgrade a configuration with obsolete values. The old value is the key of the hash, the new one is the value of the hash',
       ],

Added: branches/upstream/libconfig-model-itself-perl/current/t/dot_graph.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/t/dot_graph.t?rev=33644&op=file
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/t/dot_graph.t (added)
+++ branches/upstream/libconfig-model-itself-perl/current/t/dot_graph.t Tue Apr 21 12:06:21 2009
@@ -1,0 +1,65 @@
+# -*- cperl -*-
+# $Author: ddumont $
+# $Date: 2009-04-06 13:57:55 +0200 (Mon, 06 Apr 2009) $
+# $Revision: 919 $
+
+use ExtUtils::testlib;
+use Test::More tests => 4;
+use Config::Model;
+use Log::Log4perl qw(:easy) ;
+use Config::Model::Itself ;
+
+use warnings;
+no warnings qw(once);
+
+use strict;
+
+use vars qw/$model/;
+
+$model = Config::Model -> new(legacy => 'ignore',)  ;
+
+my $arg = shift || '' ;
+my $trace = $arg =~ /t/ ? 1 : 0 ;
+$::verbose          = 1 if $arg =~ /v/;
+$::debug            = 1 if $arg =~ /d/;
+Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
+
+use Log::Log4perl qw(:easy) ;
+Log::Log4perl->easy_init($arg =~ /l/ ? $TRACE: $WARN);
+
+ok(1,"compiled");
+
+mkdir('wr_test') unless -d 'wr_test' ;
+
+my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
+
+my $meta_inst = $meta_model
+  -> instance (root_class_name   => 'Itself::Model', 
+	       instance_name     => 'itself_instance',
+	       root_dir          => "data",
+	      );
+ok($meta_inst,"Read Itself::Model and created instance") ;
+
+my $meta_root = $meta_inst -> config_root ;
+
+my $rw_obj = Config::Model::Itself -> new(model_object => $meta_root ) ;
+
+my $model_dir = 'lib/Config/Model/models' ;
+my $map = $rw_obj -> read_all( model_dir => $model_dir,
+			       root_model => 'Itself',
+			       force_load   => 1,
+			     ) ;
+
+ok(1,"Read all models from $model_dir") ;
+
+my $dot_file = "wr_test/config-test.dot";
+
+my $res =  $rw_obj->get_dot_diagram ;
+ok($res,"got dot data, written in $dot_file") ;
+
+print $res if $trace ;
+
+open(TMP,">$dot_file") || die "Cannot open $dot_file:$!";
+print TMP $res;
+close TMP ;
+

Modified: branches/upstream/libconfig-model-itself-perl/current/t/itself-editor.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/t/itself-editor.t?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/t/itself-editor.t (original)
+++ branches/upstream/libconfig-model-itself-perl/current/t/itself-editor.t Tue Apr 21 12:06:21 2009
@@ -4,7 +4,7 @@
 # $Revision: 1.5 $
 
 use ExtUtils::testlib;
-use Test::More tests => 7;
+use Test::More ;
 use Config::Model;
 use Log::Log4perl qw(:easy) ;
 use Data::Dumper ;
@@ -46,8 +46,19 @@
     # do not use Test::Warnings with this
     $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /unknown backend/};
 }
+else {
+    # workaround Augeas locale bug
+    no warnings qw/uninitialized/;
+    if ($ENV{LC_ALL} ne 'C' or $ENV{LANG} ne 'C') {
+	$ENV{LC_ALL} = $ENV{LANG} = 'C';
+	my $inc = join(' ',map("-I$_", at INC)) ;
+	exec("$^X $inc $0 @ARGV");
+    }
+}
 
-Log::Log4perl->easy_init($log ? $DEBUG: $WARN);
+plan tests => 7 ; # avoid double print of plan when exec is run
+
+Log::Log4perl->easy_init($log ? $DEBUG: $ERROR);
 
 my $meta_model = Config::Model -> new ( ) ;
 

Modified: branches/upstream/libconfig-model-itself-perl/current/t/itself.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-itself-perl/current/t/itself.t?rev=33644&op=diff
==============================================================================
--- branches/upstream/libconfig-model-itself-perl/current/t/itself.t (original)
+++ branches/upstream/libconfig-model-itself-perl/current/t/itself.t Tue Apr 21 12:06:21 2009
@@ -5,7 +5,7 @@
 # $Revision: 1.5 $
 
 use ExtUtils::testlib;
-use Test::More tests => 18;
+use Test::More ;
 use Config::Model;
 use Log::Log4perl qw(:easy) ;
 use Data::Dumper ;
@@ -24,7 +24,7 @@
 $::verbose          = 1 if $arg =~ /v/;
 $::debug            = 1 if $arg =~ /d/;
 
-Log::Log4perl->easy_init($arg =~ /l/ ? $DEBUG: $WARN);
+Log::Log4perl->easy_init($arg =~ /l/ ? $DEBUG: $ERROR);
 
 my $wr_test = 'wr_test' ;
 my $wr_conf1 = "$wr_test/wr_conf1";
@@ -42,7 +42,17 @@
     # do not use Test::Warnings with this
     $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /unknown backend/};
 }
-
+else {
+    # workaround Augeas locale bug
+    no warnings qw/uninitialized/;
+    if ($ENV{LC_ALL} ne 'C' or $ENV{LANG} ne 'C') {
+	$ENV{LC_ALL} = $ENV{LANG} = 'C';
+	my $inc = join(' ',map("-I$_", at INC)) ;
+	exec("$^X $inc $0 @ARGV");
+    }
+}
+
+plan tests => 18 ; # avoid double print of plan when exec is run
 
 my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
 
@@ -60,7 +70,7 @@
 my $wanted = sub { 
     return if /svn|data$|~$/ ;
     s!data/!! ;
-    -d $File::Find::name && mkpath( "$wr_model1/$_", {mode => 0755}) ;
+    -d $File::Find::name && mkpath( ["$wr_model1/$_"], 0, 0755) ;
     -f $File::Find::name && copy($File::Find::name,"$wr_model1/$_") ;
 };
 find ({ wanted =>$wanted, no_chdir=>1} ,'data') ;
@@ -143,6 +153,13 @@
      'MasterModel/SshdWithAugeas.pl' => [
 					 'MasterModel::SshdWithAugeas',
 					],
+     'MasterModel/References.pl' => [
+				     'MasterModel::References::Host',
+				     'MasterModel::References::If',
+				     'MasterModel::References::Lan',
+				     'MasterModel::References::Node',
+				     'MasterModel::References'
+				    ],
     };
 
 is_deeply($expected_map, $map, "Check file class map") ;




More information about the Pkg-perl-cvs-commits mailing list