r25389 - in /branches/upstream/libconfig-model-perl/current: ChangeLog META.yml lib/Config/Model.pm lib/Config/Model/ListId.pm lib/Config/Model/Value.pm t/array_id.t
nxvl-guest at users.alioth.debian.org
nxvl-guest at users.alioth.debian.org
Fri Sep 19 17:49:20 UTC 2008
Author: nxvl-guest
Date: Fri Sep 19 17:49:17 2008
New Revision: 25389
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25389
Log:
[svn-upgrade] Integrating new upstream version, libconfig-model-perl (0.625)
Modified:
branches/upstream/libconfig-model-perl/current/ChangeLog
branches/upstream/libconfig-model-perl/current/META.yml
branches/upstream/libconfig-model-perl/current/lib/Config/Model.pm
branches/upstream/libconfig-model-perl/current/lib/Config/Model/ListId.pm
branches/upstream/libconfig-model-perl/current/lib/Config/Model/Value.pm
branches/upstream/libconfig-model-perl/current/t/array_id.t
Modified: branches/upstream/libconfig-model-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-perl/current/ChangeLog?rev=25389&op=diff
==============================================================================
--- branches/upstream/libconfig-model-perl/current/ChangeLog (original)
+++ branches/upstream/libconfig-model-perl/current/ChangeLog Fri Sep 19 17:49:17 2008
@@ -1,3 +1,10 @@
+2008-07-30 Dominique Dumont <dominique.dumont at hp.com> v0.625
+
+ * lib/Config/Model/ListId.pm (swap): Swapped or moved values in a
+ list no longer provides wrong location in config
+ tree. (index_value were not updated in objects contained in List
+ after a swap or a move)
+
2008-07-24 Dominique Dumont v0.624
* lib/Config/Model/Value.pm and others: Modified to allow smooth
Modified: branches/upstream/libconfig-model-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-perl/current/META.yml?rev=25389&op=diff
==============================================================================
--- branches/upstream/libconfig-model-perl/current/META.yml (original)
+++ branches/upstream/libconfig-model-perl/current/META.yml Fri Sep 19 17:49:17 2008
@@ -1,6 +1,6 @@
---
name: Config-Model
-version: 0.624
+version: 0.625
author:
- Dominique Dumont (ddumont at cpan dot org)
abstract: Describe and edit configuration data
@@ -25,7 +25,7 @@
provides:
Config::Model:
file: lib/Config/Model.pm
- version: 0.624
+ version: 0.625
Config::Model::AnyId:
file: lib/Config/Model/AnyId.pm
version: 1.0721
@@ -83,7 +83,7 @@
version: 1.0716
Config::Model::ListId:
file: lib/Config/Model/ListId.pm
- version: 1.0708
+ version: 1.0740
Config::Model::Loader:
file: lib/Config/Model/Loader.pm
version: 1.0717
@@ -107,7 +107,7 @@
version: 1.0669
Config::Model::Value:
file: lib/Config/Model/Value.pm
- version: 1.0729
+ version: 1.0740
Config::Model::ValueComputer:
file: lib/Config/Model/ValueComputer.pm
version: 1.0728
Modified: branches/upstream/libconfig-model-perl/current/lib/Config/Model.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-perl/current/lib/Config/Model.pm?rev=25389&op=diff
==============================================================================
--- branches/upstream/libconfig-model-perl/current/lib/Config/Model.pm (original)
+++ branches/upstream/libconfig-model-perl/current/lib/Config/Model.pm Fri Sep 19 17:49:17 2008
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2008-07-20 16:59:30 +0200 (Sun, 20 Jul 2008) $
-# $Revision: 725 $
+# $Date: 2008-07-30 14:01:04 +0200 (Wed, 30 Jul 2008) $
+# $Revision: 740 $
# Copyright (c) 2005-2008 Dominique Dumont.
#
@@ -34,7 +34,7 @@
# this class holds the version number of the package
use vars qw($VERSION @status @level @experience_list %experience_index) ;
-$VERSION = '0.624';
+$VERSION = '0.625';
=head1 NAME
@@ -674,7 +674,9 @@
$info->{cargo}{warp});
}
- if (defined $info->{cargo} && $info->{cargo}{type} eq 'warped_node') {
+ if ( defined $info->{cargo}
+ && defined $info->{cargo}{type}
+ && $info->{cargo}{type} eq 'warped_node') {
$self->translate_warp_info($config_class_name,$elt_name, $info->{cargo});
}
Modified: branches/upstream/libconfig-model-perl/current/lib/Config/Model/ListId.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-perl/current/lib/Config/Model/ListId.pm?rev=25389&op=diff
==============================================================================
--- branches/upstream/libconfig-model-perl/current/lib/Config/Model/ListId.pm (original)
+++ branches/upstream/libconfig-model-perl/current/lib/Config/Model/ListId.pm Fri Sep 19 17:49:17 2008
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2008-07-07 17:52:23 +0200 (Mon, 07 Jul 2008) $
-# $Revision: 708 $
+# $Date: 2008-07-30 14:01:04 +0200 (Wed, 30 Jul 2008) $
+# $Revision: 740 $
# Copyright (c) 2005-2007 Dominique Dumont.
#
@@ -30,7 +30,7 @@
use base qw/Config::Model::AnyId/ ;
use vars qw($VERSION) ;
-$VERSION = sprintf "1.%04d", q$Revision: 708 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 740 $ =~ /(\d+)/;
=head1 NAME
@@ -158,6 +158,10 @@
my $self = shift ;
my $idx = 0 ;
map { $self->fetch_with_id( $idx++ )->store( $_ ) ; } @_ ;
+
+ # and delete unused items
+ my $max = scalar @{$self->{data}} ;
+ splice @{$self->{data}}, $idx, $max - $idx ;
}
# store without any check
@@ -211,10 +215,20 @@
my $ida = shift ;
my $idb = shift ;
- my $tmp = $self->{data}[$ida] ;
- $self->{data}[$ida] = $self->{data}[$idb] ;
- $self->{data}[$idb] = $tmp ;
-}
+ my $obja = $self->{data}[$ida] ;
+ my $objb = $self->{data}[$idb] ;
+
+ # swap the index values contained in the objects
+ my $obja_index = $obja->index_value ;
+ $obja->index_value( $objb->index_value ) ;
+ $objb->index_value( $obja_index ) ;
+
+ # then swap the objects
+ $self->{data}[$ida] = $objb ;
+ $self->{data}[$idb] = $obja ;
+}
+
+#die "check index number after wap";
=head2 remove ( idx )
Modified: branches/upstream/libconfig-model-perl/current/lib/Config/Model/Value.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-perl/current/lib/Config/Model/Value.pm?rev=25389&op=diff
==============================================================================
--- branches/upstream/libconfig-model-perl/current/lib/Config/Model/Value.pm (original)
+++ branches/upstream/libconfig-model-perl/current/lib/Config/Model/Value.pm Fri Sep 19 17:49:17 2008
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2008-07-24 18:29:18 +0200 (Thu, 24 Jul 2008) $
-# $Revision: 729 $
+# $Date: 2008-07-30 14:01:04 +0200 (Wed, 30 Jul 2008) $
+# $Revision: 740 $
# Copyright (c) 2005-2007 Dominique Dumont.
#
@@ -36,7 +36,7 @@
use vars qw($VERSION) ;
-$VERSION = sprintf "1.%04d", q$Revision: 729 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 740 $ =~ /(\d+)/;
=head1 NAME
@@ -953,6 +953,7 @@
# accessor to get some fields through methods (See man perltootc)
foreach my $datum (@accessible_params) {
+ next if $datum eq 'index_value' ; #provided by AnyThing
no strict "refs"; # to register new methods in package
*$datum = sub {
my $self= shift;
Modified: branches/upstream/libconfig-model-perl/current/t/array_id.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-perl/current/t/array_id.t?rev=25389&op=diff
==============================================================================
--- branches/upstream/libconfig-model-perl/current/t/array_id.t (original)
+++ branches/upstream/libconfig-model-perl/current/t/array_id.t Fri Sep 19 17:49:17 2008
@@ -1,7 +1,7 @@
# -*- cperl -*-
# $Author: ddumont $
-# $Date: 2008-04-15 13:57:49 +0200 (Tue, 15 Apr 2008) $
-# $Revision: 608 $
+# $Date: 2008-07-30 14:01:04 +0200 (Wed, 30 Jul 2008) $
+# $Revision: 740 $
use warnings FATAL => qw(all);
@@ -9,7 +9,7 @@
use Test::More;
use Config::Model;
-BEGIN { plan tests => 22; }
+BEGIN { plan tests => 53; }
use strict;
@@ -64,8 +64,26 @@
default => [2..5],
@element
},
+ olist => {
+ type => 'list',
+ cargo => { type=>'node',
+ config_class_name => 'Slave'} ,
+ }
]
) ;
+
+$model -> create_config_class
+ (
+ name => "Slave",
+ element
+ => [
+ [qw/X Y Z/] => {
+ type => 'leaf',
+ value_type => 'enum',
+ choice => [qw/Av Bv Cv/]
+ },
+ ]
+ );
my $inst = $model->instance (root_class_name => 'Master',
instance_name => 'test1');
@@ -106,15 +124,61 @@
my $lac = $root->fetch_element('list_with_auto_created_id');
is_deeply([$lac->get_all_indexes],[0 .. 3],"check list_with_auto_created_id") ;
+map{ is($b->fetch_with_id($_)->index_value, $_,
+ "Check index value $_" ); } (0 .. 4) ;
+
$b->move(3,4) ;
-is($b->fetch_with_id(3)->fetch, undef ,"check after move") ;
-is($b->fetch_with_id(4)->fetch, 'toto',"check after move") ;
+is($b->fetch_with_id(3)->fetch, undef ,"check after move idx 3 in 4") ;
+is($b->fetch_with_id(4)->fetch, 'toto',"check after move idx 3 in 4") ;
+map{ is($b->fetch_with_id($_)->index_value, $_,
+ "Check moved index value $_" ); } (0 .. 4) ;
$b->fetch_with_id(3)->store('titi');
$b->swap(3,4) ;
-is($b->fetch_with_id(3)->fetch, 'toto',"check after swap") ;
-is($b->fetch_with_id(4)->fetch, 'titi',"check after swap") ;
+map{ is($b->fetch_with_id($_)->index_value, $_,
+ "Check swapped index value $_" ); } (0 .. 4) ;
+
+is($b->fetch_with_id(3)->fetch, 'toto',"check value after swap") ;
+is($b->fetch_with_id(4)->fetch, 'titi',"check value after swap") ;
$b->remove(3) ;
is($b->fetch_with_id(3)->fetch, 'titi',"check after remove") ;
+
+# test move swap with node list
+my $ol = $root->fetch_element('olist') ;
+
+my @set = ( [ qw/X Av/],
+ [ qw/X Bv/],
+ [ qw/Y Av/],
+ [ qw/Z Cv/],
+ [ qw/Z Av/],
+ );
+
+my $i = 0;
+foreach my $item (@set) {
+ my ($e,$v) = @$item;
+ $ol->fetch_with_id($i++)->fetch_element($e)->store($v)
+}
+
+$ol->move(3,4) ;
+is($ol->fetch_with_id(3)->fetch_element('Z')->fetch, undef ,
+ "check after move idx 3 in 4") ;
+is($ol->fetch_with_id(4)->fetch_element('Z')->fetch, 'Cv',
+ "check after move idx 3 in 4") ;
+map{ is($ol->fetch_with_id($_)->index_value, $_,
+ "Check moved index value $_" ); } (0 .. 4) ;
+
+$ol->swap(0,2) ;
+is($ol->fetch_with_id(0)->fetch_element('X')->fetch, undef ,
+ "check after move idx 0 in 2") ;
+is($ol->fetch_with_id(0)->fetch_element('Y')->fetch, 'Av' ,
+ "check after move") ;
+
+is($ol->fetch_with_id(2)->fetch_element('Y')->fetch, undef ,
+ "check after move") ;
+is($ol->fetch_with_id(2)->fetch_element('X')->fetch, 'Av' ,
+ "check after move") ;
+
+map{ is($ol->fetch_with_id($_)->index_value, $_,
+ "Check moved index value $_" ); } (0 .. 4) ;
More information about the Pkg-perl-cvs-commits
mailing list