[Arsperl-devel] ARSperl/t 40createcharmenu.t, NONE, 1.1 41setcharmenu.t, NONE, 1.1 31createschema.t, 1.1, 1.2 32createcontainer.t, 1.1, 1.2 33setcontainer.t, 1.1, 1.2 34createactlink.t, 1.1, 1.2 35setactlink.t, 1.1, 1.2 36createfilter.t, 1.1, 1.2 37setfilter.t, 1.1, 1.2 38createescalation.t, 1.1, 1.2 39setescalation.t, 1.1, 1.2

[Thilo S. <ts...@us...>]

Update of /cvsroot/arsperl/ARSperl/t
In directory sc8-pr-cvs11.sourceforge.net:/tmp/cvs-serv3915/t

Modified Files:
	31createschema.t 32createcontainer.t 33setcontainer.t 
	34createactlink.t 35setactlink.t 36createfilter.t 
	37setfilter.t 38createescalation.t 39setescalation.t 
Added Files:
	40createcharmenu.t 41setcharmenu.t 
Log Message:
added ars_Create/SetCharMenu, ars_SetImpersonatedUser

--- NEW FILE: 40createcharmenu.t ---
#!perl

# perl -w -Iblib/lib -Iblib/arch t/40createcharmenu.t 

use strict;
use ARS;
require './t/config.cache';

print "1..2\n";


my $ctrl = ars_Login( &CCACHE::SERVER, &CCACHE::USERNAME, &CCACHE::PASSWORD );
if (defined($ctrl)) {
	print "ok [1] (login)\n";
} else {
	print "not ok [1] (login $ars_errstr)\n";
	exit(0);
}


#my @objects = sort {lc($a) cmp lc($b)} ars_GetListCharMenu( $ctrl );
#die "ars_GetListCharMenu( ALL ): $ars_errstr\n" if $ars_errstr;
#my @objects = ( 'zTEST:CharMenu_List' );
my @objects = ( 'ARSperl Test-menu-search1' );


$| = 1;


foreach my $obj ( @objects ){
	next if $obj =~ / \((copy|renamed)\)$/;
	my $objNew = "$obj (copy)";
	ars_DeleteCharMenu( $ctrl, $objNew );
	copyObject( $ctrl, $obj, $objNew );
}


sub copyObject {
	my( $ctrl, $obj, $objNew ) = @_;
	print '-' x 60, "\n";
#	print "GET MENU $ctnr\n";
	my $wfObj = ars_GetCharMenu( $ctrl, $obj );
	die "ars_GetCharMenu( $obj ): $ars_errstr\n" if $ars_errstr;

#use Data::Dumper;
#$Data::Dumper::Sortkeys = 1;
#print Data::Dumper->Dump( [$wfObj], ['wfObj'] );

	$wfObj->{name} = $objNew;

	@{$wfObj->{objPropList}} = grep {$_->{prop} < 90000} @{$wfObj->{objPropList}};
#	foreach my $prop ( @{$ctnrObj->{objPropList}} ){
#		$prop->{value} .= 'xCopy' if $prop->{prop} == 60020 && $prop->{value} ne '';
#	}
	$wfObj->{changeDiary} = "Init";

	my $ret = 1;
	print "CREATE MENU $objNew\n";
	$ret = ars_CreateCharMenu( $ctrl, $wfObj );
	if( $ars_errstr ){
		if( $ars_errstr =~ /\[ERROR\]/ ){
			die "ars_CreateCharMenu( $objNew ): $ars_errstr\n";
		}else{
			warn "ars_CreateCharMenu( $objNew ): $ars_errstr\n";
		}
	}
	printStatus( $ret, 2, 'create menu' );
}

sub printStatus {
	my( $ret, $num, $text, $err ) = @_;
	if( $ret ){
		print "ok [$num] ($text)\n";
	} else {
		print "not ok [$num] ($text $err)\n";
		exit(0);
	}
}


#ars_Logoff($ctrl);
sleep 5;
exit(0);





Index: 37setfilter.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/37setfilter.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 37setfilter.t	3 Feb 2007 02:33:11 -0000	1.1
--- 37setfilter.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 28,46 ****
  
  foreach my $obj ( @objects ){
! 	modifyObject( $ctrl, $obj );
  }
  
  
  sub modifyObject {
! 	my( $ctrl, $obj ) = @_;
  	print '-' x 60, "\n";
! #	print "GET FILTER $obj\n";
! 	my $wfObj = ars_GetFilter( $ctrl, $obj );
! 	die "ars_GetFilter( $obj ): $ars_errstr\n" if $ars_errstr;
! 
! 	my( $name, $newName );
! 	$newName = $name = $wfObj->{name};
! 	$newName .= '_TEST';
! 
  
  	my $ret = 1;
--- 28,45 ----
  
  foreach my $obj ( @objects ){
! 	next if $obj !~ / \(copy\)$/;
! 	my $objNew = $obj;
! 	$objNew =~ s/ \(copy\)$/ (renamed)/;
! 	ars_DeleteFilter( $ctrl, $objNew );
! 	modifyObject( $ctrl, $obj, $objNew );
  }
  
  
  sub modifyObject {
! 	my( $ctrl, $name, $newName ) = @_;
  	print '-' x 60, "\n";
! #	print "GET FILTER $name\n";
! 	my $wfObj = ars_GetFilter( $ctrl, $name );
! 	die "ars_GetFilter( $name ): $ars_errstr\n" if $ars_errstr;
  
  	my $ret = 1;

Index: 38createescalation.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/38createescalation.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 38createescalation.t	3 Feb 2007 02:33:11 -0000	1.1
--- 38createescalation.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 21,25 ****
  #my @objects = sort {lc($a) cmp lc($b)} ars_GetListEscalation( $ctrl );
  #die "ars_GetListEscalation( ALL ): $ars_errstr\n" if $ars_errstr;
- #my @objects = ( 'ARSperl Test-escalation1', 'MSR:SRJ:Zuweisung_Wartend' );
  #my @objects = ( 'zTEST:TimeInterval', 'zTEST:TimeDate' );
  my @objects = ( 'ARSperl Test-escalation1' );
--- 21,24 ----
***************
*** 30,33 ****
--- 29,33 ----
  
  foreach my $obj ( @objects ){
+ 	next if $obj =~ / \((copy|renamed)\)$/;
  	my $objNew = "$obj (copy)";
  	ars_DeleteEscalation( $ctrl, $objNew );

--- NEW FILE: 41setcharmenu.t ---
#!perl

# perl -w -Iblib/lib -Iblib/arch t/41setcharmenu.t 

use strict;
use ARS;
require './t/config.cache';

print "1..2\n";


my $ctrl = ars_Login( &CCACHE::SERVER, &CCACHE::USERNAME, &CCACHE::PASSWORD );
if (defined($ctrl)) {
	print "ok [1] (login)\n";
} else {
	print "not ok [1] (login $ars_errstr)\n";
	exit(0);
}


#my @objects = sort {lc($a) cmp lc($b)} grep {/\(copy\)/} ars_GetListCharMenu( $ctrl );
#die "ars_GetListCharMenu( ALL ): $ars_errstr\n" if $ars_errstr;
#my @objects = ( 'zTEST:CharMenu_List (copy)' );
my @objects = ( 'ARSperl Test-menu-search1 (copy)' );


$| = 1;


foreach my $obj ( @objects ){
	next if $obj !~ / \(copy\)$/;
	my $objNew = $obj;
	$objNew =~ s/ \(copy\)$/ (renamed)/;
	ars_DeleteCharMenu( $ctrl, $objNew );
	modifyObject( $ctrl, $obj, $objNew );
}


sub modifyObject {
	my( $ctrl, $name, $newName ) = @_;
	print '-' x 60, "\n";
#	print "GET MENU $name\n";
	my $wfObj = ars_GetCharMenu( $ctrl, $name );
	die "ars_GetCharMenu( $name ): $ars_errstr\n" if $ars_errstr;

	my $ret = 1;
	print "SET MENU $name\n";
	$ret = ars_SetCharMenu( $ctrl, $wfObj->{name}, {name => $newName} );
	die "ars_SetCharMenu( $name ): $ars_errstr\n" if $ars_errstr;
	printStatus( $ret, 2, 'set menu' );
}

sub printStatus {
	my( $ret, $num, $text, $err ) = @_;
	if( $ret ){
		print "ok [$num] ($text)\n";
	} else {
		print "not ok [$num] ($text $err)\n";
		exit(0);
	}
}

sub makeRef {
	my( %args ) = @_;
	$args{label} = ''       if !exists $args{label};
	$args{description} = '' if !exists $args{description};
	if( $args{dataType} == 1 ){
		$args{permittedGroups} = [] if !exists $args{permittedGroups};
		$args{value}          = undef  if !exists $args{value};
		$args{value_dataType} = 'null' if !exists $args{value_dataType};
	}
	return \%args;	
}


#ars_Logoff($ctrl);
exit(0);





Index: 39setescalation.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/39setescalation.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 39setescalation.t	3 Feb 2007 02:33:11 -0000	1.1
--- 39setescalation.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 28,46 ****
  
  foreach my $obj ( @objects ){
! 	modifyObject( $ctrl, $obj );
  }
  
  
  sub modifyObject {
! 	my( $ctrl, $obj ) = @_;
  	print '-' x 60, "\n";
! #	print "GET ESCALATION $obj\n";
! 	my $wfObj = ars_GetEscalation( $ctrl, $obj );
! 	die "ars_GetEscalation( $obj ): $ars_errstr\n" if $ars_errstr;
! 
! 	my( $name, $newName );
! 	$newName = $name = $wfObj->{name};
! 	$newName =~ s/\(copy\)/(renamed)/;
! 
  
  	my $ret = 1;
--- 28,45 ----
  
  foreach my $obj ( @objects ){
! 	next if $obj !~ / \(copy\)$/;
! 	my $objNew = $obj;
! 	$objNew =~ s/ \(copy\)$/ (renamed)/;
! 	ars_DeleteEscalation( $ctrl, $objNew );
! 	modifyObject( $ctrl, $obj, $objNew );
  }
  
  
  sub modifyObject {
! 	my( $ctrl, $name, $newName ) = @_;
  	print '-' x 60, "\n";
! #	print "GET ESCALATION $name\n";
! 	my $wfObj = ars_GetEscalation( $ctrl, $name );
! 	die "ars_GetEscalation( $name ): $ars_errstr\n" if $ars_errstr;
  
  	my $ret = 1;

Index: 35setactlink.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/35setactlink.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 35setactlink.t	3 Feb 2007 02:33:11 -0000	1.1
--- 35setactlink.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 28,50 ****
  
  foreach my $obj ( @objects ){
! 	modifyObject( $ctrl, $obj );
  }
  
  
  sub modifyObject {
! 	my( $ctrl, $obj ) = @_;
  	print '-' x 60, "\n";
  #	print "GET ACTIVE LINK $obj\n";
! 	my $wfObj = ars_GetActiveLink( $ctrl, $obj );
! 	die "ars_GetActiveLink( $obj ): $ars_errstr\n" if $ars_errstr;
! 
! 	my( $name, $newName );
! 	$newName = $name = $wfObj->{name};
! 	$newName =~ s/\(copy\)/(renamed)/;
! 
  
  	my $ret = 1;
  	print "SET ACTIVE LINK $name\n";
! 	$ret = ars_SetActiveLink( $ctrl, $name, {enable => 0, order => 327} );
  	die "ars_SetActiveLink( $name ): $ars_errstr\n" if $ars_errstr;
  	printStatus( $ret, 2, 'set active link' );
--- 28,49 ----
  
  foreach my $obj ( @objects ){
! 	next if $obj !~ / \(copy\)$/;
! 	my $objNew = $obj;
! 	$objNew =~ s/ \(copy\)$/ (renamed)/;
! 	ars_DeleteActiveLink( $ctrl, $objNew );
! 	modifyObject( $ctrl, $obj, $objNew );
  }
  
  
  sub modifyObject {
! 	my( $ctrl, $name, $newName ) = @_;
  	print '-' x 60, "\n";
  #	print "GET ACTIVE LINK $obj\n";
! 	my $wfObj = ars_GetActiveLink( $ctrl, $name );
! 	die "ars_GetActiveLink( $name ): $ars_errstr\n" if $ars_errstr;
  
  	my $ret = 1;
  	print "SET ACTIVE LINK $name\n";
! 	$ret = ars_SetActiveLink( $ctrl, $name, {name => $newName, enable => 0, order => 327} );
  	die "ars_SetActiveLink( $name ): $ars_errstr\n" if $ars_errstr;
  	printStatus( $ret, 2, 'set active link' );

Index: 33setcontainer.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/33setcontainer.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 33setcontainer.t	3 Feb 2007 02:33:11 -0000	1.1
--- 33setcontainer.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 20,26 ****
  
  
! #my @containers = sort {lc($a) cmp lc($b)} grep {/\(copy\)/} map {$_->{containerName}} grep {$_->{type} =~ /guide/} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
  #die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
! my @containers = ( 'ARSperl Test-FilterGuide1 (copy)' );
  
  
--- 20,26 ----
  
  
! #my @objects = sort {lc($a) cmp lc($b)} grep {/\(copy\)/} map {$_->{containerName}} grep {$_->{containerType} =~ /guide/} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
  #die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
! my @objects = ( 'ARSperl Test-FilterGuide1 (copy)' );
  
  
***************
*** 28,47 ****
  
  
! foreach my $ctnr ( @containers ){
! 	addReferences( $ctrl, $ctnr );
  }
  
  
! sub addReferences {
! 	my( $ctrl, $ctnr ) = @_;
  	print '-' x 60, "\n";
  #	print "GET CONTAINER $ctnr\n";
! 	my $ctnrObj = ars_GetContainer( $ctrl, $ctnr );
! 	die "ars_GetContainer( $ctnr ): $ars_errstr\n" if $ars_errstr;
  #	my $ctnrType = $ctnrObj->{containerType};
  
- 	my( $name, $newName );
- 	$newName = $name = $ctnrObj->{name};
- 	$newName =~ s/\(copy\)/(renamed)/;
  	my @refList = @{$ctnrObj->{referenceList}}; 
  
--- 28,48 ----
  
  
! foreach my $obj ( @objects ){
! 	next if $obj !~ / \(copy\)$/;
! 	my $objNew = $obj;
! 	$objNew =~ s/ \(copy\)$/ (renamed)/;
! 	ars_DeleteContainer( $ctrl, $objNew );
! 	modifyObject( $ctrl, $obj, $objNew );
  }
  
  
! sub modifyObject {
! 	my( $ctrl, $name, $newName ) = @_;
  	print '-' x 60, "\n";
  #	print "GET CONTAINER $ctnr\n";
! 	my $ctnrObj = ars_GetContainer( $ctrl, $name );
! 	die "ars_GetContainer( $name ): $ars_errstr\n" if $ars_errstr;
  #	my $ctnrType = $ctnrObj->{containerType};
  
  	my @refList = @{$ctnrObj->{referenceList}}; 
  
***************
*** 80,84 ****
  	my $ret = 1;
  	print "SET CONTAINER $name\n";
! 	$ret = ars_SetContainer( $ctrl, $ctnrObj->{name}, {name => $newName, referenceList => \@refList} );
  	die "ars_SetContainer( $name ): $ars_errstr\n" if $ars_errstr;
  	printStatus( $ret, 2, 'set container' );
--- 81,85 ----
  	my $ret = 1;
  	print "SET CONTAINER $name\n";
! 	$ret = ars_SetContainer( $ctrl, $name, {name => $newName, referenceList => \@refList} );
  	die "ars_SetContainer( $name ): $ars_errstr\n" if $ars_errstr;
  	printStatus( $ret, 2, 'set container' );

Index: 34createactlink.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/34createactlink.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 34createactlink.t	3 Feb 2007 02:33:11 -0000	1.1
--- 34createactlink.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 28,31 ****
--- 28,32 ----
  
  foreach my $obj ( @objects ){
+ 	next if $obj =~ / \((copy|renamed)\)$/;
  	my $objNew = "$obj (copy)";
  	ars_DeleteActiveLink( $ctrl, $objNew );

Index: 32createcontainer.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/32createcontainer.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 32createcontainer.t	3 Feb 2007 02:33:11 -0000	1.1
--- 32createcontainer.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 22,26 ****
  #my @containers = sort {lc($a) cmp lc($b)} map {$_->{containerName}} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
  #die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
! #my @containers = sort {lc($a) cmp lc($b)} map {$_->{containerName}} grep {$_->{type} =~ /guide/} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
  #die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
  my @containers = ( 'ARSperl Test-FilterGuide1' );
--- 22,26 ----
  #my @containers = sort {lc($a) cmp lc($b)} map {$_->{containerName}} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
  #die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
! #my @containers = sort {lc($a) cmp lc($b)} map {$_->{containerName}} grep {$_->{containerType} =~ /guide/} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
  #die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
  my @containers = ( 'ARSperl Test-FilterGuide1' );
***************
*** 31,34 ****
--- 31,35 ----
  
  foreach my $ctnr ( @containers ){
+ 	next if $ctnr =~ / \((copy|renamed)\)$/;
  	my $ctnrNew = "$ctnr (copy)";
  	ars_DeleteContainer( $ctrl, $ctnrNew );
***************
*** 49,52 ****
--- 50,55 ----
  #	print Data::Dumper->Dump( [$ctnrObj], ['ctnrObj'] );
  
+ 	$ctnrObj->{name} = $ctnrNew;
+ 
  	@{$ctnrObj->{objPropList}} = grep {$_->{prop} < 90000} @{$ctnrObj->{objPropList}};
  	foreach my $prop ( @{$ctnrObj->{objPropList}} ){
***************
*** 57,61 ****
  	my $ret = 1;
  	print "CREATE CONTAINER $ctnrNew\n";
! 	$ret = ars_CreateContainer( $ctrl, $ctnrNew, $ctnrObj );
  	die "ars_CreateContainer( $ctnrNew ): $ars_errstr\n" if $ars_errstr;
  	printStatus( $ret, 2, 'create container' );
--- 60,64 ----
  	my $ret = 1;
  	print "CREATE CONTAINER $ctnrNew\n";
! 	$ret = ars_CreateContainer( $ctrl, $ctnrObj );
  	die "ars_CreateContainer( $ctnrNew ): $ars_errstr\n" if $ars_errstr;
  	printStatus( $ret, 2, 'create container' );

Index: 31createschema.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/31createschema.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 31createschema.t	3 Feb 2007 02:33:11 -0000	1.1
--- 31createschema.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 28,41 ****
  #	'AR System Administrator Preference',
  #);
- #my @forms = ( 'ARSperl Test', 'ARSperl Test2', 'ARSperl Test-join', 'ARSperl Test3' );
- #my @forms = sort {lc($a) cmp lc($b)} grep {/^BPM:/} ars_GetListSchema( $ctrl, 0, 1024 );			# all
  #my @forms = sort {lc($a) cmp lc($b)} grep {$_ ge "BPM:MA:"} grep {/^BPM:/} ars_GetListSchema( $ctrl, 0, 1024 );			# all
  #die "ars_GetListSchema( ALL ): $ars_errstr\n" if $ars_errstr;
  my @forms = ( 'ARSperl Test3' );
  
  $| = 1;
  
  
  foreach my $form ( @forms ){
  	my $formNew = "$form (copy)";
  	ars_DeleteSchema( $ctrl, $formNew, 1 );
--- 28,43 ----
  #	'AR System Administrator Preference',
  #);
  #my @forms = sort {lc($a) cmp lc($b)} grep {$_ ge "BPM:MA:"} grep {/^BPM:/} ars_GetListSchema( $ctrl, 0, 1024 );			# all
+ #my @forms = sort {lc($a) cmp lc($b)} grep {/^BPM:/} ars_GetListSchema( $ctrl, 0, 1024 );			# all
  #die "ars_GetListSchema( ALL ): $ars_errstr\n" if $ars_errstr;
+ #my @forms = ( 'ARSperl Test', 'ARSperl Test2', 'ARSperl Test-join', 'ARSperl Test3' );
  my @forms = ( 'ARSperl Test3' );
  
+ 
  $| = 1;
  
  
  foreach my $form ( @forms ){
+ 	next if $form =~ / \((copy|renamed)\)$/;
  	my $formNew = "$form (copy)";
  	ars_DeleteSchema( $ctrl, $formNew, 1 );
***************
*** 68,72 ****
  	print "CREATE SCHEMA $formNew\n";
  	$ret = ars_CreateSchema( $ctrl, $formNew, $formObj );
! 	die "ars_CreateSchema( $formNew ): $ars_errstr\n" if $ars_errstr;
  	printStatus( $ret, 2, 'create schema' );
  	sleep 5;
--- 70,86 ----
  	print "CREATE SCHEMA $formNew\n";
  	$ret = ars_CreateSchema( $ctrl, $formNew, $formObj );
! 	if( $ars_errstr ){
! 		my $errTxt = $ars_errstr;
! #		$errTxt =~ s/\[WARNING\].*?\(ARERR #50\)/  (admin only)/;
! #		$errTxt =~ s/\[WARNING\] rev_ARQualifierStruct: hv_fetch \(hval\) returned null \(ARERR #80020\)//;
! 		$errTxt =~ s/\[WARNING\].*?\(ARERR #8985\)/  (roles removed)/;
! 		$errTxt =~ s/\[WARNING\].*?\(ARERR #8981\)/  (app owner property)/;
! 		if( $errTxt =~ /ARERR/ ){
! 			print "ars_CreateSchema( $formNew ): $ars_errstr\n";
! 		}else{
! 			print $errTxt;
! 		}
! 	}
! 	print "\n";
  	printStatus( $ret, 2, 'create schema' );
  	sleep 5;
***************
*** 132,147 ****
  		die "ars_GetField( $form, $fieldId ): $ars_errstr\n" if $ars_errstr; 
  
- 
  #		test_DisplayInstanceList( $ctrl, $form, $fieldSt );
  #		next;
  
- 
- 
  		$fieldSt->{changeDiary} = "COPY";
  
  		if( ($formType ne 'join' && $fieldId <= 8) || $fieldId == 1 ){
  			print "SET FIELD $fieldId $fieldSt->{dataType}\n";
! 			$rv = ars_SetField( $ctrl, $formNew, {
! 				fieldId   => $fieldId,
  				fieldName => $fieldSt->{fieldName},
  				limit     => $fieldSt->{limit},
--- 146,157 ----
  		die "ars_GetField( $form, $fieldId ): $ars_errstr\n" if $ars_errstr; 
  
  #		test_DisplayInstanceList( $ctrl, $form, $fieldSt );
  #		next;
  
  		$fieldSt->{changeDiary} = "COPY";
  
  		if( ($formType ne 'join' && $fieldId <= 8) || $fieldId == 1 ){
  			print "SET FIELD $fieldId $fieldSt->{dataType}\n";
! 			$rv = ars_SetField( $ctrl, $formNew, $fieldId, {
  				fieldName => $fieldSt->{fieldName},
  				limit     => $fieldSt->{limit},
***************
*** 176,181 ****
  	foreach my $fieldId ( keys %tableLimit ){
  		print "SET TABLE LIMIT $fieldId\n";
! 		$rv = ars_SetField( $ctrl, $formNew, {
! 			fieldId  => int($fieldId),   # necessary for uintcpyHVal (SvIOK)
  			option   => 4,               # necessary to avoid ARERR 118
  			limit    => $tableLimit{$fieldId},
--- 186,190 ----
  	foreach my $fieldId ( keys %tableLimit ){
  		print "SET TABLE LIMIT $fieldId\n";
! 		$rv = ars_SetField( $ctrl, $formNew, $fieldId, {
  			option   => 4,               # necessary to avoid ARERR 118
  			limit    => $tableLimit{$fieldId},

Index: 36createfilter.t
===================================================================
RCS file: /cvsroot/arsperl/ARSperl/t/36createfilter.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** 36createfilter.t	3 Feb 2007 02:33:11 -0000	1.1
--- 36createfilter.t	6 Mar 2007 01:54:27 -0000	1.2
***************
*** 28,31 ****
--- 28,32 ----
  
  foreach my $obj ( @objects ){
+ 	next if $obj =~ / \((copy|renamed)\)$/;
  	my $objNew = "$obj (copy)";
  	ars_DeleteFilter( $ctrl, $objNew );