view release on metacpan or  search on metacpan

lib/ARSObject.pm  view on Meta::CPAN

 }
 elsif ($c eq '(') {
	$r =$c;
	while ($q =~/^(.*?)([()'"])(.*)/) {
		$q  =$3;
		$r .=$1;
		if ($2 eq ')')	{$r .=$2; last}
		else		{$r .=_qsubst($s, $2, $q, $f)}
	}
	$_[2] =$q;
 }
 elsif ($c =~/['"]/) {
	my $cq =$s->strquot($c);
	$cq =substr($cq,1,-1);
	$r =$c;
	while ($q =~/^(.*?)(\Q$c\E|\Q$cq\E)(.*)/) {
		$q =$3;
		$r .=$1 .$2;
		last if $2 eq $c;
	}
	$_[2] =$q;
 }
 elsif ($c eq ',') {
	my @r;
	while ($q =~/^(.*?)(['"(]|\Q$c\E)(.*)/i) {
		$q =$3;
		$r .=$1;
		if ($2 eq $c) {
			push @r, ($r =~/^\s*(.*?)\s*$/ ? $1 : $r);
			$r ='';
		}
		else {
			$r .=_qsubst($s, $2, $q, $f);
		}
	}
	$r .=$q;
	push @r, ($r =~/^\s*(.*?)\s*$/ ? $1 : $r) if $r ne '';
	return(@r)
 }
 else {
	$r =$c .$q
 }
 $r
}


sub entry {	# ars_GetEntry
		# (-from=>form, -id=>entryId, ?-for=>{}, ?-fields=>[internalId,...])
		#	-> {fieldName => value}
 #		# Field Ids translated using -schdn/-schid
 # -from ||-form ||-schema => schema name
 # -id => entryId
 # -fields => [internalId, fieldName,...]
 # -for => {} # steady hash to store each entry fetched
 # ?-echo=>1
 #
 # ars_GetEntry(ctrl,schema,entry_id,...) -> (internalId => value,...)
 # no ars_GetEntryBLOB(ctrl,schema,entry_id,field_id,locType,locFile)
 # no ars_EncodeDiary(diaryEntryHash1, ... diaryEntryHashN)
 # encoded 'Status-History'
 # decoded 'diary'
 #
 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-from};
 print $s->cpcon("entry(-form=>'$f',-id=>'$a{-id}')\n")
	if $s->{-echo} || $a{-echo};
 my %r =ARS::ars_GetEntry($s->{-ctrl},$f,$a{-id}
	,$a{-fields} 
		? (map {/^\d+$/ ? $_ : schdn($s, $f, $_)->{fieldId}} @{$a{-fields}})
		: ()
	);
 if (%r) {
	my $rr =$a{-for} ||{};
	undef(@{$rr}{keys %$rr}) if %$rr;
	# @{$rr}{map {schid($s,$f,$_)->{fieldName}} keys %r} =values %r;
	# return($rr);
	local $_;
	local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '') ."entry(-form=>'$f',-id=>'$a{-id}')";
	foreach my $id (keys %r) {
		my $ff =schdi($s,$f,$id);
		if ($ff) {
			$rr->{$ff->{fieldName}} 
				= !$s->{-strFields}
				? $r{$id}
				: $ff->{strOut}
				? &{$ff->{strOut}}($s,$f,$ff,$_=$r{$id})
				: strOut($s,$f,$id,$r{$id})
		}
		else {
			$rr->{$id} =$r{$id}
		}
	}
	return($rr)
 }
 return($ARS::ars_errstr
	? &{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'entry',-form=>$f,-id=>$a{-id}))
	: {})
}


sub entryOut {	# Format entry hash ref for output
		# (schema, entry, ?sample) -> entry
 my ($s, $f, $r, $rr) =@_;
 if ($rr) {
	undef(@{$rr}{keys %$rr}) if %$rr;
 }
 else {
	$rr ={}
 }
 local $_;
 foreach my $id (keys %$r) {
	my $ff =schdi($s,$f,$id);
	my $v  =$r->{$id};
	if ($ff) {
		$rr->{$ff->{fieldName}} 
			= !$s->{-strFields}
			? $r->{$id}
			: $ff->{strOut}
			? &{$ff->{strOut}}($s,$f,$ff,$_=$v)
			: strOut($s,$f,$id,$v);
	}