view release on metacpan or  search on metacpan

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

#	die "ars_DeleteVUI( $formNew, 536870912 ): $ars_errstr\n" if $ars_errstr;


	my @views = ars_GetListVUI( $ctrl, $form, 0 );
	die "ars_GetListVUI( $form ): $ars_errstr\n" if $ars_errstr;

	my( $vuiId_New ) = ars_GetListVUI( $ctrl, $formNew, 0 );
	die "ars_GetListVUI( $formNew ): $ars_errstr\n" if $ars_errstr;


	my $vuiSt = ars_GetVUI( $ctrl, $formNew, $vuiId_New );
	die "ars_GetVUI( $formNew, $vuiId_New ): $ars_errstr\n" if $ars_errstr;
	foreach my $prop ( @{$vuiSt->{props}} ){
		$prop->{value} .= " $vuiId_New" if $prop->{prop} == 20;
	}
	$vuiSt->{vuiName} .= " $vuiId_New";
	print "SET VUI $vuiId_New\n";
	$ret = ars_SetVUI( $ctrl, $formNew, $vuiId_New, $vuiSt );
	die "ars_SetVUI( $formNew, $vuiId_New ): $ars_errstr\n" if $ars_errstr;
	printStatus( $ret, 3, 'set vui' );



	( $ret, $rv ) = ( 1, 0 );
	foreach my $vuiId ( @views ){
		$vuiSt = ars_GetVUI( $ctrl, $form, $vuiId );
		die "ars_GetVUI( $form, $vuiId ): $ars_errstr\n" if $ars_errstr;

		if( $vuiId == $vuiId_New ){ 
			print "SET VUI $vuiId\n";
			$rv = ars_SetVUI( $ctrl, $formNew, $vuiId, $vuiSt );
			die "ars_SetVUI( $formNew, $vuiId ): $ars_errstr\n" if $ars_errstr;
		}else{
			print "CREATE VUI $vuiId\n";
			$rv = ars_CreateVUI( $ctrl, $formNew, $vuiSt );
			die "ars_CreateVUI( $formNew, $vuiId ): $ars_errstr\n" if $ars_errstr;
		}
		$ret &&= $rv;
	}
	printStatus( $ret, 4, 'create vui' );

	my @fieldIds;
	push @fieldIds, sort {$a <=> $b} ars_GetListField( $ctrl, $form, 0,  0b00010000 );  # page_holder
	die "ars_GetListField( $form ): $ars_errstr\n" if $ars_errstr;
	push @fieldIds, sort {$a <=> $b} ars_GetListField( $ctrl, $form, 0, 0b00001000 );  # page
	die "ars_GetListField( $form ): $ars_errstr\n" if $ars_errstr;
	push @fieldIds, sort {$a <=> $b} ars_GetListField( $ctrl, $form, 0, 0b11110000111 );   # other
	die "ars_GetListField( $form ): $ars_errstr\n" if $ars_errstr;
	push @fieldIds, sort {$a <=> $b} ars_GetListField( $ctrl, $form, 0, 0b00100000 );  # table
	die "ars_GetListField( $form ): $ars_errstr\n" if $ars_errstr;
	push @fieldIds, sort {$a <=> $b} ars_GetListField( $ctrl, $form, 0, 0b01000000 );  # column
	die "ars_GetListField( $form ): $ars_errstr\n" if $ars_errstr;

	my %tableLimit;

	( $ret, $rv ) = ( 1, 0 );
	foreach my $fieldId ( @fieldIds ){
		my $fieldSt = ars_GetField( $ctrl, $form, $fieldId );
		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},
				displayInstanceList => $fieldSt->{displayInstanceList},
			} );
			warn "ars_SetField( $formNew, $fieldId ): $ars_errstr\n" if $ars_errstr;
		}elsif( ($formType eq 'join' && $fieldId > 1 && $fieldId != 15) || $fieldId > 15 ){
			print "CREATE FIELD $fieldId $fieldSt->{dataType}";
			if( $fieldSt->{dataType} eq 'table' ){
				$tableLimit{$fieldId} = { %{$fieldSt->{limit}} };
				$tableLimit{$fieldId}{qualifier} = $fieldSt->{limit}{qualifier};
				$fieldSt->{limit}{qualifier} = {};
			}

			$rv = ars_CreateField( $ctrl, $formNew, $fieldSt, 1 );
			if( $ars_errstr ){
				my $errTxt = $ars_errstr;
				$errTxt =~ s/\[WARNING\].*?\(ARERR #50\)/  (admin only)/;
				$errTxt =~ s/\[WARNING\].*?\(ARERR #8985\)/  (roles removed)/;
				$errTxt =~ s/\[WARNING\] rev_ARQualifierStruct: hv_fetch \(hval\) returned null \(ARERR #80020\)//;
				if( $errTxt =~ /ARERR/ ){
					print "  ars_CreateField( $formNew, $fieldId ): $ars_errstr\n";
				}else{
					print $errTxt;
				}
			}
			print "\n";
		}
		$ret &&= $rv;
	}
	sleep 5;
	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},
		} );
		warn "ars_SetField( $formNew, $fieldId ): $ars_errstr\n" if $ars_errstr;
		$ret &&= $rv;
	}

	printStatus( $ret, 5, 'create/set field' );

	my %schemaInfo;
	$schemaInfo{getListFields} = $aGetListFields if $aGetListFields;
	$schemaInfo{indexList}     = $aIndexList     if $aIndexList;
	$schemaInfo{sortList}      = $aSortList      if $aSortList;
#	$schemaInfo{archiveInfo}   = $hArchiveInfo   if $hArchiveInfo;
	$schemaInfo{auditInfo}     = $hAuditInfo     if $hAuditInfo;

	print "SET SCHEMA $formNew\n";
	$ret = ars_SetSchema( $ctrl, $formNew, \%schemaInfo );
	warn "ars_SetSchema( $formNew ): $ars_errstr\n" if $ars_errstr;
	printStatus( $ret, 6, 'set schema' );