view release on metacpan or  search on metacpan

lib/ARSObject.pm  view on Meta::CPAN

	foreach my $kh (keys %{$s->{$f}}) {
		if (!defined($s->{$f}->{$kh}->{$k})) {
		}
		elsif ($v && !defined(eval{$t =&$v($s, $f, $k, $_ =$s->{$k}->{$kh})}) && $@) {
			last if $@ =~/^last[\r\n]*$/;
			next if $@ =~/^next[\r\n]*$/;
			return(&{$s->{-die}}($s->efmt($@,$s->{-cmd})));
		}
		elsif (!$v ||$t) {
			$rh{$s->{$f}->{$kh}->{$k}} =1
		}
	}
 }
 use locale;
 return([sort {$a cmp $b} keys %rh])
}



sub connect {		# Connect to ARS server
 eval('use ARS');	# (-param=>value,...) -> self
 my $s =shift;		# -srv, -usr, -pswd, -lang
 $s->set(@_);
 $s->set(-die=>'Carp') if !$s->{-die};
 local $s->{-cmd} ="connect()";
 return($s) if $s->{-ctrl};
 print $s->cpcon("connect()\n") if $s->{-echo};
 return($s) if $s->{-ctrl} && ARS::ars_VerifyUser($s->{-ctrl});
 $s->{-ctrl} =ARS::ars_Login(
		$s->{-srv}, $s->{-usr}, $s->{-pswd}, $s->{-lang}
		, '' # , join('-', ($ENV{COMPUTERNAME} ||$ENV{HOSTNAME} ||eval('use Sys::Hostname;hostname') ||'localhost'), getlogin() || $> || '', $$, $^T, time())
		, 0, 0)
	|| return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_Login', map {$_=>$s->{$_}} qw(-srv -usr -lang))));
 $s->{-ctrl} && ARS::ars_SetSessionConfiguration($s->{-ctrl}, &ARS::AR_SESS_OVERRIDE_PREV_IP, 1);
 $s->arsmeta();
 $s
}


sub disconnect {	# Disconnect data servers
 my $s =shift;
 $s->{-ctrl} && eval{ars_Logoff($s->{-ctrl})};
 $s->{-ctrl}=undef;
 $s->{-dbi} && eval{$s->{-dbi}->disconnect()};
 $s->{-dbi} =undef;
}


sub arsmeta {		# Load/refresh ARS metadata
 my $s =shift;		# -srv, -usr, -pswd, -lang
 $s->set(@_);
 local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
	.($s->{-schgen} ? "dumper('" .$s->vfname('meta') ."')" : 'arsmeta()');
 if (ref($s->{-schgen})
 || ($s->{-schgen} && ($s->{-schgen} >1))
 || (!-e $s->vfname('-meta'))
	) {
	#
	# Data types:
	# 'integer','real','char','enum','time','decimal'
	# 'diary','attach','currency'
	# 'trim','control','table','column','page','page_holder'
	#
	my ($vfs, $vfu);
	local $s->{-schgen} =$s->{-schgen};
	if (ref($s->{-schgen}) && (-e $s->vfname('-meta'))) {
		$s->vfload('-meta');
	}
	elsif (($s->{-schgen} >1) && (-e $s->vfname('-meta'))) {
		$s->vfload('-meta');
		$vfs =$s->{-schgen} >2
			? 0
			: ([stat $s->vfname('-meta')]->[9] ||0);
	}
	else {
		$s->{-meta} ={};
	}
	foreach my $f (ref($s->{-schgen}) ? @{$s->{-schgen}} : @{$s->{-schema}}){
		my $fa =ARS::ars_GetSchema($s->{-ctrl}, $f);
		!$fa && return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetSchema',$f)));
		if ($vfs && $s->{-meta}->{$f}) {
			#print $s->strtime($fa->{timestamp}),'/',$s->strtime($vfs), "\n", $s->cpcon($s->dsdump($fa)), "\n"; exit(0);
			next	if $s->{-meta}->{$f} && $s->{-meta}->{$f}->{timestamp}
				? (($s->{-meta}->{$f}->{timestamp}||0) >=($fa->{timestamp}||0))
					&& ($vfs >=($fa->{timestamp}||0))
				: $vfs >=($fa->{timestamp}||0 +60*60);
		}
		$vfu =1;
		$s->{-meta}->{$f} ={}; # {} || $fa
		$s->{-meta}->{$f}->{-fields} ={};
		$s->{-meta}->{$f}->{timestamp} =$fa->{timestamp};
		# $s->{-meta}->{$f}->{indexList} =$fa->{indexList};
		# $s->{-meta}->{$f}->{getListFields} =$fa->{getListFields};
		# $s->{-meta}->{$f}->{sortList} =$fa->{sortList};
		my ($cyr, $vli, $vll) =1 && $s->{-lang} && ($s->{-lang} =~/^(?:ru)/i);
		if (!$cyr && $s->{-lang}) {
			my $vlc;
			my $ull =$s->{-lang} =~/^([A-Za-z]+)/  ? $1 : $s->{-lang};
			my $ulc =$s->{-lang} =~/^([A-Za-z_]+)/ ? $1 : $s->{-lang};
			my $i =0;
			foreach my $vi (ars_GetListVUI($s->{-ctrl}, $f, 0)) {
				my $vw =ars_GetVUI($s->{-ctrl}, $f, $vi);
				# language[_territory[.codeset]][@modifier]
				# en_US.ISO8859-15@euro
				$vli =$i if !defined($vli) && !$vw->{locale};
				$vlc =$i if !defined($vlc) &&  $vw->{locale} && ($vw->{locale} =~/^\Q$ulc\E/);
				$vll =$i if !defined($vll) &&  $vw->{locale} && ($vw->{locale} =~/^\Q$ull\E/);
				last if defined($vli) && defined($vlc) && defined($vll);
				$i++
			}
			$vll =$vlc if defined($vlc);
		}
		my $ix ={map {$_->{unique}
				&& (scalar(@{$_->{fieldIds}}) ==1)
				? ($_->{fieldIds}->[0] => 1)
				: ()} @{$fa->{indexList}}};
		my %ff =ARS::ars_GetFieldTable($s->{-ctrl}, $f);
		!%ff && return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetFieldTable',$f)));
		foreach my $ff (sort keys %ff) {
			my $fm =ARS::ars_GetField($s->{-ctrl},$f,$ff{$ff})
				|| return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetField',$f,$ff)));

lib/ARSObject.pm  view on Meta::CPAN

	: map {	my $ff =$s->{-meta}->{$f}->{-fields}->{$_};
		join("\t", $f
			#, $ff->{option} && ($ff->{option} == 4) ? 'ro' : ()
			, (map {  $_ eq 'fieldLblc'
				? join('; '
					, map {$ff->{$_} ? $ff->{$_} : ()
						} $ff->{$_} ? ('fieldLblc') : ('fieldLbl', 'fieldLbll'), 'fieldLbv', 'fieldLbvl', 'helpText')
				: !defined($ff->{$_})
				? ''
				: $_ eq 'option'
				? (!$ff->{$_} ? '' : $ff->{$_} == 4 ? 'r' : $ff->{$_} == 2 ? 'o' : $ff->{$_} == 1 ? 'm' : '')
				: $ff->{$_}
				} @a[0..$#a]))
		} sort keys %{$s->{-meta}->{$f}->{-fields}}
	} sort keys %{$s->{-meta}}
}


sub query {	# ars_GetListEntry / ars_LoadQualifier
 #		(-clause=>val) -> list
 #		(...-for=>sub{}) -> self
 #		Field Ids translated using -metadn/-metaid
 # -from ||-form ||-schema => schema name
 # -where || -query ||-qual => search condition
 #		Syntax:
 #		'fieldId' || 'fieldName' - fields
 #		"string value" - strings
 #		digits - numeric value, number of seconds as date value
 #		strIn(form, fieldName, value) - to encode value for '-where'
 #
 # -fields => [{fieldId=>1, columnWidth=>9, separator=>"\t"},...
 #		,[{fieldName=>name, width=>9},...
 #		,[{field=>name|id, width=>9},...] # 128 bytes limit strings
 # ||-fields => [fieldId | fieldName,...]	# using ars_GetListEntryWithFields()
 # ||-fields => '*' | 1 | '*-$', -xfields=>sub{} || [fieldName| fieldId,...]
 # ||-fetch => '*' | 1 | [fieldId|fieldName,...] # using ars_GetEntry() for each record
 # -order ||-sort => [fieldId, (1||2),...] # 1 - asc, 2 - desc
 #			[..., fieldName, field=>'desc', field=>'asc',...]
 # -limit ||-max => maxRetrieve
 # -first ||-start => firstRetrieve
 # -for ||-foreach => sub(self, form, id|string, ?{record}){die "last\n", die "next\n"} -> self
 # ?-echo=>1
 #
 # ars_GetListEntry(ctrl, schema, qualifier, maxRetrieve=0, firstRetrieve=0,...)
 #		..., getListFields, sortList,... 
 # ars_LoadQualifier(ctrl, schema, qualifier string)
 #
 # Using the advanced search bar:
 # 'Currency Field.VALUE'	'Currency Field' = $NULL$
 # ??? BookValue=> {conversionDate=> 1090544110, currencyCode=> 'USD', funcList=> [{currencyCode=> 'USD', value=> '0.00'}, {currencyCode=> 'EUR', value=> ''}, {currencyCode=> 'GBP', value=> ''}, {currencyCode=> 'JPY', value=> ''}, {currencyCode=> 'CA...
 # 'Status History.Fixed.TIME' < "07/01/99"
 # 'Create date' > "10:00:00"
 #
 my $s =shift;
 my %a =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-from};
 my $c =$a{-for} ||$a{-foreach};

 if ($a{-fields} && !ref($a{-fields})) {
	my $q ='trim|control|table|column|page';
	$q .= '|currency|attach' if $a{-fields} =~/^-\$/;
	$q .= '|attach'		 if $a{-fields} =~/^-f/;
	$a{-fields} = 
		[map {  my $ff =$s->{-meta}->{$f}->{-fields}->{$_};
			!$ff->{dataType} || !$ff->{fieldId}
			|| ($ff->{dataType} =~/^($q)/)
			|| ($ff->{fieldId} eq '15')	# 'Status-History' 
							# ars_GetListEntryWithFields() -> [ERROR] (ORA-00904: "C15": invalid identifier) (ARERR #552)
			|| (!$a{-xfields} ? 0 : ref($a{-xfields}) eq 'CODE' ? &{$a{-xfields}}($s, $ff) :  grep {($_ eq $ff->{fieldId}) || ($_ eq $ff->{fieldName})} @{$a{-xfields}})
			? ()
			: ($ff->{fieldId})
			} sort keys %{$s->{-meta}->{$f}->{-fields}}]
 }

 $a{-fetch} =1	if $a{-fields} && !ref($a{-fields});
 delete $a{-fields}	if $a{-fetch};

 local $s->{-cmd} ="query(" .join(', ',map {!defined($a{$_}) ? () : ref($a{$_}) ? "$_=>" .dsquot($s,$a{$_}) : ("$_=>" .strquot($s,$a{$_}))
		} qw(-schema -form -from -fields -fetch -qual -query -where -sort -order -limit -max -maxRetrieve -first -start))
		.")";

 my $fl = ref($a{-fetch})
	? [map {/^\d+$/ ? $_ : schdn($s,$f,$_)->{fieldId}} @{$a{-fetch}}]
	: $a{-fields} && ref($a{-fields}->[0])
	? [map {ref($_)
			? {fieldId=>$_->{fieldId} ||schdn($s,$f, $_->{fieldName} ||$_->{field})->{fieldId}
				, separator=>$_->{separator} ||"\t"
				, columnWidth=>$_->{columnWidth} ||$_->{width} ||10
				}
			: {fieldId=>/^\d+$/ ? $_ : schdn($s,$f,$_)->{fieldId}
				, separator=>"\t"
				, columnWidth=>10
				}
			} @{$a{-fields}}]
	: $a{-fields}
	? [map {/^\d+$/ ? $_ : schdn($s,$f,$_)->{fieldId}} @{$a{-fields}}]
	: [];
 my @fs;
	{my ($v, $x, @r) =($a{-sort} ||$a{-order});
	@fs =	$v
		? (map {if (!$x) {$x =$_; @r=()}
			elsif(/^(desc|2)$/) {@r =($x=~/^\d+$/ ? $x : schdn($s,$f,$x)->{fieldId}, 2); $x =undef}
			else {@r=($x =~/^\d+$/ ? $x : schdn($s,$f,$x)->{fieldId},1); $x=undef if /^(asc|1)$/}
			@r} @$v)
		: ();
	push @fs, $x =~/^\d+$/ ? $x : schdn($s,$f,$x)->{fieldId}, 1
		if $x}
 my $q =$s->_qsubst('',$a{-qual} ||$a{-query} ||$a{-where}, $f);
 $s->{-cmd} .=": subst(-from=>'$f'"
		.(@$fl ? ',-fields=>' .join(', ', map {ref($_) ? "'" .$_->{fieldId} ."'(" .$_->{columnWidth} .")" : "'$_'"
			} @$fl) : '')
		.($q ? ",-where=>$q" : '')
		.(@fs ? ',-order=>' .join(', ', map {"'$_'"} @fs) : '')
		.")" 
		if 0;
 $q =ARS::ars_LoadQualifier($s->{-ctrl}, $f, $q);
 return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd})))
	if !$q;
 $s->{-cmd} .=": qual". $s->dsquot(ARS::ars_perl_qualifier($s->{-ctrl}, $q))
	if 0;

 print $s->cpcon(join(";\n", split /\):\s/, $s->{-cmd})), "\n"