view release on metacpan or  search on metacpan

t/31createschema.t  view on Meta::CPAN

#!perl

# perl -w -Iblib/lib -Iblib/arch t/31createschema.t 

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

print "1..6\n";


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


#my %excl = map {$_ => 1} (
#	'Group',
#	'User', 
#	'Alert Events', 
#	'Application Pending', 
#	'Application Statistics', 
#	'Application Statistics Configuration',
#	'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 );
	copyForm( $ctrl, $form, $formNew );
}

my $formType;

sub copyForm {
	my( $ctrl, $form, $formNew ) = @_;
	print '-' x 60, "\n";
#	print "GET SCHEMA $form\n";
	my $formObj = ars_GetSchema( $ctrl, $form );
	die "ars_GetSchema( $form ): $ars_errstr\n" if $ars_errstr;
	my $formType = $formObj->{schema}{schemaType};
	$formObj->{name} = $formNew;
	$formObj->{changeDiary} = "Init";

	my( $aGetListFields, $aIndexList, $aSortList, $hArchiveInfo, $hAuditInfo );
	$aGetListFields = delete $formObj->{getListFields} if exists($formObj->{getListFields});
	$aIndexList     = delete $formObj->{indexList}     if exists($formObj->{indexList});
	$aSortList      = delete $formObj->{sortList}      if exists($formObj->{sortList});
	$hArchiveInfo   = delete $formObj->{archiveInfo}   if exists($formObj->{archiveInfo});
	$hAuditInfo     = delete $formObj->{auditInfo}     if exists($formObj->{auditInfo});
	$hArchiveInfo->{formName} .= ' (copy)' if $hArchiveInfo;

	foreach my $hProp ( @{$formObj->{objPropList}} ){
		$hProp->{value} .= 'copy' if $hProp->{prop} == 60018 && $hProp->{value};
	}

	my( $ret, $rv ) = ( 1, 0 );


	print "CREATE SCHEMA $formNew\n";
	$ret = ars_CreateSchema( $ctrl, $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;

#	ars_DeleteVUI( $ctrl, $formNew, 536870912 );