• Your recent searches
ARSObject
2 results

 view release on metacpan or  search on metacpan

lib/ARSObject.pm  view on Meta::CPAN 

$VERSION = '0.57';

my $fretry =8;

1;

sub new {	# New ARS object
		# (-param=>value,...) -> ARS object
 my $c=shift;
 my $s ={'' => ''
	,-ctrl => undef		# ARS control struct from ars_Login()
	,-srv  => undef		# Server name
	,-usr  => undef		# User name
	,-pswd => undef		# Password string
	,-lang => ''		# Language
	,-schema => undef	# Schemas to use: [form,...]
	,-vfbase =>		# Var files base
			(do{	my $v =$^O eq 'MSWin32' ? scalar(Win32::GetFullPathName($0)) : $0;
				$v =~/^(.+?)\.[^\\\/]*$/ ? "$1-" : "$v-"
			})
	#,-storable =>undef	# Use Storable module for cache files?
	,-schgen => 1		# 1 - use vfname('meta') for '-meta', generate it from ARS if not exists.
				# 2 - renewable 'meta' smartly
				# 3 - renew meta always
				# [schema,...] - list to renew
	,-schfdo => 0		# Include display only fields into schema (AR_FIELD_OPTION_DISPLAY)
	,-meta => {}		# Forms metadata from ARS:
				#	{formName}->{-fields}->{fieldName}=>{}
				#	{formName}->{-fldids}->{fieldId}=>{}
				#	Additional parameters may be:
				#	,'fieldLbl' =>label

lib/ARSObject.pm  view on Meta::CPAN 

				#		-sqlschema
	,-metax => 		# Exclude field schema parameters from '-meta'
			['displayInstanceList','permissions']
	,-metaid => {}		# Commonly used fields with common names and value translation
	,-metadn => {}		# {fieldId | fieldName => 
				#	{fieldName=>'name',FieldId=>id
				#	,strIn=>sub(self,form,{field},$_=val){}
				#	,strOut=>sub(self,form,{field},$_=val){}
				#	},...}
	,-maxRetrieve => 0	# ARS::ars_GetListEntry(maxRetrieve)
	,-entryNo => undef	# Logical number of entry inserted
	,-strFields => 1	# Translate fields data using 'strIn'/'strOut'/'-meta'?
				# 1 - 'enumLimits', 2 - 'fieldLbvl' before 'enumLimits'
	,-cmd =>''		# Command running, for err messages, script local $s->{-cmd}
	,-die =>undef		# Error die/warn,  'Carp' or 'CGI::Carp...'
	# ,-diemsg => undef	#
	,-warn=>undef		# , see set() and connect() below
	# ,-warnmsg => undef	#
	,-cpcon=>undef		# Translation to console codepage sub{}(self, args) -> translated
	,-echo=>0		# Echo printout switch
	,-dbi=>undef		# DBI object, by dbiconnect()
	,-dbiconnect =>undef	#
	,-cgi=>undef		# CGI object, by cgi()
	,-smtp=>undef
	,-smtphost=>undef
	#,-fpl=>[]		# CGI Form Presenter fields list
	#,-fphc=>{}		# 	CGI fields cache
	#,-fphd=>{}		#	DB fields cache
	#,-fpbv=>[]		#	buffer values
	#,-fpbn=>''		#	buffer name == record common name
	};
 bless $s,$c;
 set($s, @_);
 $s->{-storable} =eval('use Storable; 1') if !exists($s->{-storable});
 $s
}


sub AUTOLOAD {	# Use self->arsXXX() syntax for ars_XXX(ctrl,...) calls
 my $m =substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
 return(&{$_[0]->{-die}}($_[0]->efmt("Called name without 'ars'", $_[0]->{-cmd}, undef, 'AUTOLOAD',$m)))
	if $m !~/^ars/;
 $m =~s/^ars/ars_/
	if $m !~/^ars_/;
 $m =~s/^ars/ARS::ars/
	if $m !~/^ARS::/;
 no strict;
 &$m($_[0]->{-ctrl}, @_[1..$#_])
}


sub DESTROY {
	my $s =shift;
	$s->{-die} =undef;
	$s->{-warn}=undef;
	$s->{-ctrl} && eval{ars_Logoff($s->{-ctrl})};
	$s->{-ctrl}=undef;
	$s->{-dbi} && eval{$s->{-dbi}->disconnect()};
	$s->{-dbi} =undef;
	$s->{-cgi} =undef;
	$s->{-diemsg}  =undef;
	$s->{-warnmsg} =undef;
}


sub set {	# Set/Get parameters
		# () -> (parameters)
		# (-param) -> value
		# (-param => value,...) -> self
 return(keys(%{$_[0]})) if scalar(@_) ==1;
 return($_[0]->{$_[1]}) if scalar(@_) ==2;
 my ($s,%a) =@_;

lib/ARSObject.pm  view on Meta::CPAN 

			else {
				print   $s->{-cgi}->header(-content=>'text/html'
					,($ENV{SERVER_SOFTWARE}||'') =~/IIS/ ? (-nph=>1) : ()
					)
					, "<h1>Error:</h1>"
					, $s->{-cgi}->escapeHTML($_[0])
					, "<br />\n"
					if $s && $s->{-cgi}
			}
			$s->DESTROY() if $s;
			$s =undef;
			# $SIG{__DIE__} =$sigdie;
			# &$sigdie(@_) if ref($sigdie) eq 'CODE';
			# CORE::die($_[0]);
		};
		$SIG{__WARN__} =sub{
			return if !$^W ||ineval();
			if ($s && $s->{-warnmsg}) {
				&{$s->{-warnmsg}}(@_)
			}
			else {

lib/ARSObject.pm  view on Meta::CPAN 

		,($o ? $o : ())
		,($f ? $f .'(' .join(',', map {$s->dsquot($_)} @a) .')' : ())
		,($c ? $c : ())
		)
	)
}


sub strquot {	# Quote and Escape string enclosing in ''
 my $v =$_[1];		# (string) -> escaped
 return('undef') if !defined($v);
 $v =~s/([\\'])/\\$1/g;
 $v =~s/([\x00-\x1f])/sprintf("\\x%02x",ord($1))/eg;
 $v =~/^\d+$/ ? $v : ('\'' .$v .'\'');
}


sub strquot2 {	# Quote and Escape string enclosing in ""
 my $v =$_[1];		# (string) -> escaped
 return('undef') if !defined($v);
 $v =~s/([\\"])/\\$1/g;
 $v =~s/([\x00-\x1f])/sprintf("\\x%02x",ord($1))/eg;
 $v =~/^\d+$/ ? $v : ('"' .$v .'"');
}


sub arsquot {	# Quote string for ARS
 return('NULL') if !defined($_[1]);
 my $v =$_[1];
 $v =~s/"/""/g;

lib/ARSObject.pm  view on Meta::CPAN 

	}
 }
 $r
}


sub strtime {	# Stringify Time
 my $s =shift;
 if (scalar(@_) && !defined($_[0])) {
	&{$s->{-warn}}('Not defined time in strtime()') if $^W;
	return(undef)
 }
 my $msk =(scalar(@_) ==0) || ($_[0] =~/^\d+$/i) ? 'yyyy-mm-dd hh:mm:ss' : shift;
 my @tme =(scalar(@_) ==0) ? localtime(time) : scalar(@_) ==1 ? localtime($_[0]) : @_;
 $msk =~s/yyyy/%Y/;
 $msk =~s/yy/%y/;
 $msk =~s/mm/%m/;
 $msk =~s/mm/%M/i;
 $msk =~s/dd/%d/;
 $msk =~s/hh/%H/;
 $msk =~s/hh/%h/i;
 $msk =~s/ss/%S/;
#eval('use POSIX');
 my $r =POSIX::strftime($msk, @tme);
# &{$s->{-warn}}("Not defined strtime('$msk'," .join(',', map {defined($_) ? $_ : 'undef'} @tme) .")")
#	if !defined($r);
 $r
}


sub timestr {	# Time from String
 my $s   =shift;
 if (scalar(@_) && !defined($_[0])) {
	&{$s->{-warn}}('Not defined time in timestr()') if $^W;
	return(undef)
 }
 my $msk =(scalar(@_) <2) || !$_[1] ? 'yyyy-mm-dd hh:mm:ss' : shift;
 my $ts  =$_[0];
 my %th;
 while ($msk =~/(yyyy|yy|mm|dd|hh|MM|ss)/) {
    my $m=$1; $msk =$';
    last if !($ts =~/(\d+)/);
    my $d =$1; $ts   =$';
    $d   -=1900   if $m eq 'yyyy' ||$m eq '%Y';
    $m    =chop($m);

lib/ARSObject.pm  view on Meta::CPAN 

# &{$s->{-warn}}("Not defined timestr('$_[0]')")
#	if !defined($r);
 $r
}


sub timeadd {	# Adjust time to years, months, days,...
 my $s =$_[0];
 if (!defined($_[1])) {
	&{$s->{-warn}}('Not defined time in timeadd()') if $^W;
	return(undef)
 }
 my @t =localtime($_[1]);
 my $i =5;
 foreach my $a (@_[2..$#_]) {$t[$i] += ($a||0); $i--}
#eval('use POSIX');
 POSIX::mktime(@t[0..5],0,0,$t[8])
}


sub charset {

lib/ARSObject.pm  view on Meta::CPAN 

 : ($p =~/^(.+?)[\\\/][^\\\/]+$/ ? $1 : '')
}



sub fopen {		# Open file
 my $s =shift;		# ('-b',filename) -> success
 my $o =$_[0] =~/^-(?:\w[\w\d+-]*)*$/ ? shift : '-';
 my $f =$_[0]; $f ='<' .$f if $f !~/^[<>]/;
 eval('use IO::File');
 my $h =IO::File->new($f) || return(&{$s->{-die}}($s->efmt('$!',undef,'cannot open file','fopen',$f)));
 $h->binmode() if $h && ($o =~/b/);
 $h
}


sub fdirls {		# Directory listing
 my $s =shift;		# ('-',pathname, ?filter sub{}(self, path, $_=entry), ? []) -> (list) || [list]
 my $o =$_[0] =~/^-(?:\w[\w\d+-]*)*$/ ? shift : '-';
 my ($f, $cf, $cs) =@_;
 local *FILE; opendir(FILE, $f) || return(&{$s->{-die}}($s->efmt('$!',undef,'cannot open dir','fdirls',$f)));
 local $_;
 my ($r, @r);
 if ($cs) {
	while (defined($r =readdir(FILE))) {
		push @$cs, $r if !$cf ||&$cf($s,$f,$_ =$r)
	}
	closedir(FILE);
	return $cs;
 }
 else {

lib/ARSObject.pm  view on Meta::CPAN 

 print "fstore('$f')\n" if $s->{-echo};
 # local $SIG{'TERM'} ='IGNORE';
 # local $SIG{'INT'}  ='IGNORE';
 # local $SIG{'BREAK'}='IGNORE';
 my $r;
 local *FILE;
 for (my $i =0; $i <$fretry; $i++) {
	$r =open(FILE, $f);
	last if $r;
 }
 return(&{$s->{-die}}($s->efmt('$!',undef,'cannot open file','fstore',$f)))
	if !$r;
 if ($o =~/b/) {
	binmode(FILE);
	$r =defined(syswrite(FILE,$_[1]))
 }
 else {
	$r =print FILE join("\n",@_[1..$#_])
 }
 close(FILE);
 $r || &{$s->{-die}}($s->efmt('$!',undef,'Cannot write file','fstore',$f))
}


sub fload {		# Load file
 my $s =shift;		# ('-b',filename) -> content
 my $o =$_[0] =~/^-(?:\w[\w\d+-]*)*$/ ? shift : '-';
 my($f,$f0) =($_[0],$_[0]); 
	if ($f =~/^[<>]+/)	{$f0 =$'}
	else			{$f  ='<' .$f}
 print "fload('$f')\n" if $s->{-echo};
 local *FILE;
 my $r;
 for (my $i =0; $i <$fretry; $i++) {
	$r =open(FILE, $f);
	last if $r;
 }
 return(&{$s->{-die}}($s->efmt('$!',undef,'Cannot open file','fload',$f)))
	if !$r;
 my $b =undef;
 binmode(FILE) if $o =~/b/;
 $r =read(FILE,$b,-s $f0);
 close(FILE);
 defined($r) ? $b : &{$s->{-die}}($s->efmt('$!',undef,'Cannot read file','fload',$f))
}


sub vfname {		# Name of variables file
			# (varname|-slot) -> pathname
 return($_[0]->{-vfbase}) if !$_[1];
 my $v =$_[1];	$v =~s/[\s.,:;|\/\\?*+()<>\]\["']/_/g;
 $_[0]->{-vfbase} .($v =~/^-(.+)/ ? ($1 .($_[2] ||'.var')) : ($v .($_[2] ||'.var')))
}

lib/ARSObject.pm  view on Meta::CPAN 

			# (-slot) -> success
 my($s,$n,$d)=@_;
 $d =$s->{$n} if !$d && ($n =~/^-/);
 my $f =$s->vfname($n, '.new');
 my $r;
 if (($n =~/^-/) && exists($s->{"${n}-storable"}) ? $s->{"${n}-storable"} : $s->{-storable}) {
	for (my $i =0; ($i <$fretry) && eval("use Storable; 1"); $i++) {
		$r =Storable::store($d, $f);
		last if $r;
	}
	return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'Storable::store',$f)))
		if !$r;
 }
 else {
	$r =$s->fstore('-', $f, $s->dsdump($d));
 }
 if ($r) {
	my $rr =0;
	for (my $i =0; $i <$fretry; $i++) {
		$rr =rename($f, $s->vfname($n));
		last if $rr
	}
	return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'rename',$f,'*.var')))
		if !$rr
 }
 $r
}


sub vfload {		# Load variables file
			# (varname|-slot, ?{use default} | load default, ?renew | renew seconds) -> {data}
 my($s,$f,$d,$nn) =@_;	# -slot-calc, -slot-store
 my $k =($f =~/^-/ ? $f : undef);
 $f =$s->vfname($f);
 if ($nn && $nn >1) {
	my @st =stat($f);
	$nn =0 if $st[9] && (time() -$st[9] <$nn);
 }
 if ($d && ($nn || !-f $f)) {
	if (ref($d)) {
		$s->vfstore($k, $d =ref($d) eq 'CODE' ? &$d($s,$k) : $d);
		$s->{$k} =$d if $k;
	}
	elsif (!$k) {
	}
	elsif (ref($s->{"$k-calc"}) eq 'CODE') {
		my $cc =$s->{"$k-calc"};
		local $s->{"$k-calc"} =undef;
		$s->{$k} =$d =&$cc($s,$k);
	}
	elsif (ref($s->{"$k-store"}) eq 'CODE') {
		$s->vfstore($k, $s->{$k} =$d =&{$s->{"$k-store"}}($s,$k))
	}
	elsif (ref($s->{$k}) eq 'CODE') {
		$s->vfstore($k, $s->{$k} =$d =&{$s->{$k}}($s,$k))
	}
	return($d)
 }
 elsif (ref($s->{"$k-calc"}) eq 'CODE') {
	my $cc =$s->{"$k-calc"};
	local $s->{"$k-calc"} =undef;
	$s->{$k} =$d =&$cc($s,$k);
	return($d);
 }
 my $r;
 if (0) {
	$r =($k && exists($s->{"${k}-storable"}) ? $s->{"${k}-storable"} : $s->{-storable})
	? eval("use Storable; 1")
		&& Storable::retrieve($f)
		|| return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'Storable::retrieve',$f)))
	: ((eval{do($f)}) || return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},undef,'do',$f))));
 }
 else {
	local *FILE;
	for (my $i =0; $i <$fretry; $i++) {
		$r =open(FILE, "<$f");
		last if $r;
	}
	return(&{$s->{-die}}($s->efmt('$!',undef,'Cannot open file','vfload',$f)))
		if !$r;
	binmode(FILE);
	my $v;
	sysread(FILE,$v,64,0)
		||return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'sysread',$f)));
	$r =($v 
		? $v !~/^\$VAR1\s*=/
		: ($k && exists($s->{"${k}-storable"}) ? $s->{"${k}-storable"} : $s->{-storable}))
	? ((seek(FILE,0,0) ||1)
		&& eval("use Storable; 1")
		&& Storable::fd_retrieve(\*FILE)
		|| return(&{$s->{-die}}($s->efmt('$!',$s->{-cmd},undef,'Storable::retrieve',$f))))
	: ((eval{close(FILE); 1}) &&
		do($f) || return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},undef,'do',$f)))
		);
	eval{close(FILE)};
 }
 $s->{$k} =$r if $k;
 $r
}



sub vfrenew {		# Renew variables file

lib/ARSObject.pm  view on Meta::CPAN 

}


sub vfhash {	# Access to hash of array data from variables file
		# automatically formed in memory using vfdata().
		# (-slot, key name) -> {hash from vfdata()}
		# (-slot, key name => key value) -> {key=>value,...}
		# (-slot, key name => key value => elem name ) -> elem value
		# (-slot, key name => filter sub{}(self, -slot, key, $_ = value)) -> {key=>value,...}
 my($s, $f, $k, $v, $e) =@_;
 return(&{$s->{-die}}($s->efmt('Key name needed',undef,undef,'vfhash',$f))) if !$k;
 $s->vfload($f, 1) if !$s->{$f} ||(ref($s->{$f}) eq 'CODE');
 my $kk ="$f/$k";
 if (!$s->{$kk}) {
	$s->{$kk} ={};
	if (ref($s->{$f}) eq 'ARRAY') {
		for(my $i=0; $i<=$#{$s->{$f}}; $i++) {
			$s->{$kk}->{$s->{$f}->[$i]->{$k}} =$s->{$f}->[$i]
				if defined($s->{$f}->[$i]->{$k})
		}
	}

lib/ARSObject.pm  view on Meta::CPAN 

 $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))

lib/ARSObject.pm  view on Meta::CPAN 

		$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} ={};

lib/ARSObject.pm  view on Meta::CPAN 

				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)));
			# 'fieldId', 'fieldName', 'dataType'
			next	if !$fm->{dataType}
				|| ($fm->{dataType} =~/^(trim|control|table|column|page)/);
			next	if !$s->{-schfdo} && $fm->{option} && ($fm->{option} == 4); # AR_FIELD_OPTION_DISPLAY
			$s->{-meta}->{$f}->{-fields}->{$ff} =$fm;
			$s->{-meta}->{$f}->{-fields}->{$ff}->{indexUnique} =$fm->{fieldId}
				if $ix->{$fm->{fieldId}}
				|| ($fm->{fieldId} eq '1'); # || '179'?
			if ($fm->{displayInstanceList}->{dInstanceList}
				) {

lib/ARSObject.pm  view on Meta::CPAN 

 }
 $v =$n .$nn;
 length($v) >64 ? substr($n, 0, 64 -length($nn)) .$nn : $v
}


sub sqlname {	# SQL name from ARS name
		# (formName, ?fieldName, ?force update meta) -> SQL name
		# -sqlname, -sqlntbl, -sqlncol, -sqlninc
 my($s,$f,$ff,$fu) =@_;	
 return(undef)
	if !$f;
 return($s->{'-meta-sql'}->{-forms}->{$f})
	if !$ff && !$fu
	&& $s->{'-meta-sql'}
	&& $s->{'-meta-sql'}->{-forms} 
	&& $s->{'-meta-sql'}->{-forms}->{$f};
 return($s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$f}}->{-fields}->{$ff})
	if $ff && !$fu
	&& $s->{'-meta-sql'}
	&& $s->{'-meta-sql'}->{-forms}

lib/ARSObject.pm  view on Meta::CPAN 

 ? $_[0]->{-meta}->{$_[1]}->{-fields}->{$_[2]}
 : $_[0]->{-meta}->{$_[1]}->{-fields}
}


sub schid {	# Schema info by field id
		# (schema, fieldId) -> {fieldName=>'name', FieldId=>id}
		# () -> rearranged self
 $_[0]->{-metaid}->{$_[2]}
 || $_[0]->{-meta}->{$_[1]}->{-fldids}->{$_[2]}
 || &{$_[0]->{-die}}($_[0]->efmt('Field not found',$_[0]->{-cmd},undef,'schid',$_[1],$_[2]))
}


sub schdn {	# Schema info by field distiguished name
		# (schema, fieldName) -> {fieldName=>'name', FieldId=>id}
 (($_[2] =~/^\d+$/)
	&& ($_[0]->{-metaid}->{$_[2]} 
		|| $_[0]->{-meta}->{$_[1]}->{-fldids}->{$_[2]}))
 || $_[0]->{-metadn}->{$_[2]}
 || $_[0]->{-meta}->{$_[1]}->{-fields}->{$_[2]}
 || &{$_[0]->{-die}}($_[0]->efmt('Field not found',$_[0]->{-cmd},undef,'schdn',$_[1],$_[2]))
}


sub schdi {	# Schema info by field Id
		# (schema, fieldId) -> {fieldName=>'name', FieldId=>id} || undef
 $_[0]->{-metaid}->{$_[2]}
 || $_[0]->{-meta}->{$_[1]}->{-fldids}->{$_[2]}
}


sub schlbls {	# Enum field {values => labels}
		# (schema, fieldId) -> {value=>label,...}
 my($s,$f,$ff) =@_;
 $ff =ref($ff) ? $ff
	: !$s->{-meta} || !$s->{-meta}->{$f} ? return(undef)
	: $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff}
	: $s->{-meta}->{$f}->{-fields}->{$ff}; 
 if ($ff && !$ff->{-hashOut} && ($ff->{dataType} eq 'enum')) {
	my $et =ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
		? $ff->{'limit'}->{'enumLimits'}
		: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
		? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
		: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
		? $ff->{'limit'}->{'enumLimits'}->{'customList'}
		: undef;
	if (!$et) {}
	elsif (!ref($et->[0])) {
		$ff->{-hashOut} ={map {($_ => $et->[$_])} (0..$#$et)}
	}
	elsif ((ref($et->[0]) eq 'HASH') && defined($et->[0]->{itemNumber})) {
		$ff->{-hashOut} ={map {($et->[$_]->{itemNumber} => $et->[$_]->{itemName})} (0..$#$et)}
	}
 }
 $ff && $ff->{-hashOut}
}



sub schlblsl {	# Enum field {values => labels localised}
		# (schema, fieldId) -> {value=>localised label,...}
 my($s,$f,$ff) =@_;
 $ff =ref($ff) ? $ff
	: !$s->{-meta} || !$s->{-meta}->{$f} ? return(undef)
	: $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff}
	: $s->{-meta}->{$f}->{-fields}->{$ff};
 $ff->{fieldLbvl} ? {split /\\+/, substr($ff->{fieldLbvl},1)} : schlbls($s,$f,$ff)
}



sub schvals {	# Enum field [values]
		# (schema, fieldId) -> [value,...]
 my($s,$f,$ff) =@_;
 $ff =ref($ff) ? $ff
	: !$s->{-meta} || !$s->{-meta}->{$f} ? return(undef)
	: $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff}
	: $s->{-meta}->{$f}->{-fields}->{$ff}; 
 if ($ff && !$ff->{-listVals} && ($ff->{dataType} eq 'enum')) {
	my $et =ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
		? $ff->{'limit'}->{'enumLimits'}
		: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
		? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
		: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
		? $ff->{'limit'}->{'enumLimits'}->{'customList'}
		: undef;
	if (!$et) {}
	elsif (!ref($et->[0])) {
		$ff->{-listVals} =[0..$#$et]
	}
	elsif ((ref($et->[0]) eq 'HASH') && defined($et->[0]->{itemNumber})) {
		$ff->{-listVals} =[map {$et->[$_]->{itemNumber}} (0..$#$et)]
	}
 }
 $ff && $ff->{-listVals}
}

lib/ARSObject.pm  view on Meta::CPAN 

 if (!defined($v) ||!$ff ||!$s->{-strFields}) {
 }
 elsif ($ff->{fieldLbvl} && ($s->{-strFields} ==2) && ($ff->{fieldLbvl} =~/\\\Q$v\E\\([^\\]+)/)) {
	$v =$1
 }
 elsif ($ff->{-hashOut}) {
	if (exists($ff->{-hashOut}->{$v})) {
		$v =$ff->{-hashOut}->{$v}
	}
	else {
		# return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strOut',$f,$ff->{fieldName},$v)))
	}
 }
 elsif ($ff->{dataType} eq 'enum') {
	schlbls(@_);
	$v =strOut(@_) if $ff->{-hashOut};
 }
 elsif ($ff->{dataType} eq 'time') {
	$v =strtime($s,$v)
 }
 $v

lib/ARSObject.pm  view on Meta::CPAN 

 }
 elsif ($ff->{fieldLbvl} && ($ff->{fieldLbvl} =~/\\(\d+)\\\Q$v\E(?:\\|$)/)) {
	# && ($s->{-strFields} ==2)
	$v =$1
 }
 elsif ($ff->{-hashIn}) {
	if (exists($ff->{-hashIn}->{$v})) {
		$v =$ff->{-hashIn}->{$v};
	}
	else {
		return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strIn',$f,$ff->{fieldName},$v)))
	}
 }
 elsif ($ff->{dataType} eq 'enum') {
	my $et =  ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
		? $ff->{'limit'}->{'enumLimits'}
		: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
		? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
		: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
		? $ff->{'limit'}->{'enumLimits'}->{'customList'}
		: undef;
	if (!$et) {}
	elsif (!ref($et->[0])) {
		$ff->{-hashIn} ={map {($et->[$_] => $_)} (0..$#$et)};
		$v =strIn(@_);
	}
	elsif ((ref($et->[0]) eq 'HASH') && defined($et->[0]->{itemNumber})) {
		$ff->{-hashIn} ={map {($et->[$_]->{itemName} => $et->[$_]->{itemNumber})} (0..$#$et)};
		$v =strIn(@_);
	}
	else {
		$et =undef
	}
	return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strIn',$f,$ff->{fieldName},$v)))
		if $et && ($v !~/^\d+$/);
 }
 elsif ($ff->{dataType} eq 'time') {
	$v =timestr($s,$v);
 }
 $v
}


sub lsflds {	# List fields from '-meta'

lib/ARSObject.pm  view on Meta::CPAN 

				, 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) : '')

lib/ARSObject.pm  view on Meta::CPAN 

		, @fs)) {
		if (!ref($e)) {
			$_ =$id =$e
		}
		elsif (!defined(eval{&$c($s, $f, $_ =$id, entryOut($s, $f, $e))}) && $@) {
			last if $@ =~/^last[\r\n]*$/;
			next if $@ =~/^next[\r\n]*$/;
			return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},'eval(-for)')));
		}
	}
	return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},'undef','ars_GetListEntryWithFields')))
		if !defined($id) && $ARS::ars_errstr;
	return($s);
 }
 elsif ($c) {
	my $i =undef;
	local $_ ='';
	foreach my $e (ARS::ars_GetListEntry($s->{-ctrl}, $f, $q
		, $a{-limit} ||$a{-max} ||$s->{-maxRetrieve} ||0
		, $a{-first} ||$a{-start} ||0
		, $fl
		, @fs)) {
		if ($i)	{
			$i =0;
			$_ =$_ .($fl->[0]->{separator}) .$e
				if $a{-fields};

lib/ARSObject.pm  view on Meta::CPAN 

		if (!defined(eval{&$c($s, $f, $_
			, $a{-fetch}
				? $s->entry(-from=>$f, -id=>$_
					, ref($a{-fetch}) ? (-fields => $a{-fetch}) : ())
				: ())}) && $@) {
			last if $@ =~/^last[\r\n]*$/;
			next if $@ =~/^next[\r\n]*$/;
			return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},'eval(-for)')));
		}
	}
	return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetListEntry')))
		if !defined($i) && $ARS::ars_errstr;
	return($s)
 }
 elsif ($a{-fields} && !ref($a{-fields}->[0])) {
	my @r =ARS::ars_GetListEntryWithFields($s->{-ctrl}, $f, $q
		, $a{-limit} ||$a{-max} ||$s->{-maxRetrieve} ||0
		, $a{-first} ||$a{-start} ||0
		, $fl
		, @fs);
	if (@r) {
		my @rr;
		for (my $i =0; $i <$#r; $i +=2) {
			push @rr, entryOut($s, $f, $r[$i+1])
		}
		return(@rr)
	}
	return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetListEntryWithFields')))
		if $ARS::ars_errstr;
	return(())
 }
 else {
	my @r =ARS::ars_GetListEntry($s->{-ctrl}, $f, $q
		, $a{-limit} ||$a{-max} ||$s->{-maxRetrieve} ||0
		, $a{-first} ||$a{-start} ||0
		, $fl
		, @fs);
	if (@r) {

lib/ARSObject.pm  view on Meta::CPAN 

				push @rr
				, $s->entry(-from=>$f, -id=>$r[$i]
					, ref($a{-fetch}) ? (-fields=>$a{-fetch}) : ())
			}
		}
		else {
			for (my $i =0; $i <$#r; $i +=2) { push @rr, $r[$i] }
		}
		return(@rr)
	}
	return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetListEntry')))
		if $ARS::ars_errstr;
	return(())
 }
}


sub _qsubst {	# query condition string substitutions
		# (''|char, expr string, form) -> translated
 my ($s, $c, $q, $f) =@_;
 return($q) if !defined($q) ||($q eq '');

lib/ARSObject.pm  view on Meta::CPAN 

 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}

lib/ARSObject.pm  view on Meta::CPAN 

				? &{$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}}

lib/ARSObject.pm  view on Meta::CPAN 

		$rr->{$id} =$r->{$id}
	}
 }
 $rr
}


sub entryDif {	# Diff hash refs
		# ({old}, {new}, exclude empty) -> {to update}
 my($s, $ds1, $ds2, $ee) =@_;
 return(undef) if (ref($ds1) ||'') ne (ref($ds2) ||'');
 return(undef) if (ref($ds1) ||'') ne 'HASH';
 my ($r, $rr) =({});
 foreach my $k (keys %$ds2) {
	next if !defined($ds1->{$k}) && !defined($ds2->{$k});
	next if (ref($ds1->{$k}) && ref($ds2->{$k}))
		&& !dscmp($s,$ds1,$ds2);
	next if (defined($ds1->{$k}) && defined($ds2->{$k}))
		&& ($ds1->{$k} eq $ds2->{$k});
	next if $ee && (!defined($ds2->{$k}) ||($ds2->{$k} eq ''))
		&& (!defined($ds1->{$k}) ||($ds1->{$k} eq ''));
	$r->{$k} =$ds2->{$k}; $rr =1;
 }
 $rr ? $r : undef
}


sub entryNew {	# New {field => value}
		# (-form=>form, field=>value,...) -> {field=>value,...}
		# ?'Incident Number'=>1 for 'HPD:Help Desk'
 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-into} ||$a{-for};
 delete @a{qw(-schema -form -from -into -for)};
 local $_;
 local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '') ."entryNew(-form=>'$f'," 
		.join(',', map {!defined($a{$_}) 
			? "$_=>undef"
			: ref($a{$_})
			? ("$_=>" .dsquot($s, $a{$_}))
			: ("$_=>" .strquot($s, $a{$_}))
			} sort keys %a)
		.')';
 foreach my $k (%{$s->{-meta}->{$f}->{-fields}}) {
	my $ff =$s->{-meta}->{$f}->{-fields}->{$k};
	next	if !$ff
		|| exists($a{$k})
		|| ((!defined($ff->{defaultVal}) || ref($ff->{defaultVal}))

lib/ARSObject.pm  view on Meta::CPAN 

		# ?'Incident Number'=>1 for 'HPD:Help Desk'
 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-into};
 my $r;
 print $s->cpcon("entryIns(-form=>'$f')\n")
	if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
 delete @a{qw(-schema -form -from -into -echo)};
 local $_;
 local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '') ."entryIns(-form=>'$f'," 
		.join(',', map {!defined($a{$_}) 
			? "$_=>undef"
			: ref($a{$_})
			? ("$_=>" .dsquot($s, $a{$_}))
			: ("$_=>" .strquot($s, $a{$_}))
			} sort keys %a)
		.')';
 %a = map {	my ($k, $v) =($_, $a{$_});
		if ($k !~/^\d+$/) {
			my $ff =schdn($s,$f,$k);
			$k =$ff->{fieldId};
			$v =$ff->{strIn}

lib/ARSObject.pm  view on Meta::CPAN 

 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-into};
 my $id=$a{-id};
 print $s->cpcon("entryUpd(-form=>'$f',-id=>'$id')\n")
	if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
 delete @a{qw(-schema -form -from -into -id -echo)};
 local $_;
 local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '') 
	."entryUpd(-form=>'$f',-id=>'$id',"
	.join(',', map {!defined($a{$_}) 
			? "$_=>undef"
			: ref($a{$_})
			? ("$_=>" .dsquot($s, $a{$_}))
			: ("$_=>" .strquot($s, $a{$_}))
			} sort keys %a)
	.')';
 %a = map {	my ($k, $v) =($_, $a{$_});
		if ($k !~/^\d+$/) {
			my $ff =schdn($s,$f,$k);
			$k =$ff->{fieldId};
			$v =$ff->{strIn}

lib/ARSObject.pm  view on Meta::CPAN 



sub dbiconnect {# DBI connect to any database
		# (-dbiconnect=>[]) -> dbi object
 set(@_);
 set($_[0],-die=>'Carp') if !$_[0]->{-die};
 print $_[0]->cpcon("dbiconnect()\n")
	if $_[0]->{-echo};
 eval('use DBI; 1') ||return(&{$_[0]->{-die}}($_[0]->efmt('No DBI')));
 $_[0]->{-dbi} =DBI->connect(ref($_[0]->{-dbiconnect}) ? @{$_[0]->{-dbiconnect}} : $_[0]->{-dbiconnect})
	|| &{$_[0]->{-die}}($_[0]->efmt(DBI->errstr,undef,undef,'dbiconnect') ."\n");
}


sub dbiquery {	# DBI query
		# (dbi query args) -> dbi cursor object
		# (-echo=>1,...)
 my($s, @q) =@_;
 my(%a); while ($#q && ($q[0] =~/^-/)) {$a{$q[0]} =$q[1]; shift @q; shift @q};
 print $s->cpcon("dbiquery($q[0])\n")
	if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
 my $op =$s->{-dbi}->prepare(@q)
	|| return(&{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'dbiprepair',@q)));
 $op->execute()
	|| return(&{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'dbiexecute',@q)));
 $op;
}


sub dbido {	# DBI do
		# (dbi do args) -> dbi cursor object
		# (-echo=>1,...)
 my($s, @q) =@_;
 my(%a); while ($#q && ($q[0] =~/^-/)) {$a{$q[0]} =$q[1]; shift @q; shift @q};
 print $s->cpcon("dbiquery($q[0])\n")
	if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
 $s->{-dbi}->do(@q)
	|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'dbido',@q));
}


sub dbierrstr {	# Last DBI error
 $_[0]->{-dbi}->errstr
}


sub dbitables {	# DBI tables array
 my ($s, $sch, $tbl) =@_;

lib/ARSObject.pm  view on Meta::CPAN 

 ($d->{'TYPE_NAME'} ||'unknown')
 .($d->{'COLUMN_SIZE'}
	? ' (' .join(',', map {defined($d->{$_}) ? $d->{$_} : ()
		} 'COLUMN_SIZE', 'DECIMAL_DIGITS') .')'
	: '')

}

sub dbidsmetasync {	# DBI datastore - sync meta with 'arsmetasql'
 my ($s, %arg) =@_;	# (-echo)
 return(undef) if !$s->{'-meta-sql'};
 my $dbt ={map {!$_
		? ()
		: $_ =~/\."*([^."]+)"*$/
		? (lc($1) => 1)
		: (lc($_) => 1)
	} $s->dbitables()};
 foreach my $tbl (sort keys %{$s->{'-meta-sql'}}) {
	my @sql;
	if ($tbl =~/^-/) {
		next

lib/ARSObject.pm  view on Meta::CPAN 

			push @sql
				,'ALTER TABLE '
				.join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $tbl)
				.' ALTER COLUMN ' .$r;
		}
		}
	}
	foreach my $r (@sql) {
		print "$r;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
		$s->dbi()->do($r)
		|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$r,undef,'dbidsmetasync'));
	}
 }
 $s;
}


sub dbidsrpl {	# DBI datastore - load data from ARS
 my ($s, %arg) =@_;
 $arg{-form}  =$arg{-from}  ||$arg{-schema}	if !$arg{-form};
 $arg{-query} =$arg{-where} ||$arg{-qual}	if !$arg{-query};
 $arg{-filter}=undef				if !$arg{-filter};
 $arg{-lim_rf}=300				if !$arg{-lim_rf};
 $arg{-lim_or}=40				if !$arg{-lim_or};
 $arg{-fields}='*'				if !$arg{-fields};
 # $arg{-echo}=0;
 # $arg{-ckpush}=1;	# check db pushes into ARS (_arsobject_insert, _arsobject_update, _arsobject_delete)
 # $arg{-ckdel}=0;	# check ARS deletes into db
 # $arg{-ckupd}=1;	# check ARS updates into db
 # $arg{-sleep}=0;
 # $arg{-pk}=undef;
 # $arg{-timestamp}=undef;	# field name || 0
 # $arg{-unused}=undef;
 # $arg{-master}
 # $arg{-master_pk}
 # $arg{-master_fk}
 # $arg{-master_ts}
 my $tbl =$s->sqlname($arg{-form});
 my $tbc =join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $tbl);
 my ($fpk, $fid, $fts, @flds);
 my ($ci, $cu, $cd) =(0, 0, 0);
 {      my $flds =$s->{'-meta-sql'}->{$tbl}->{-cols};
	$fpk = $flds->{$arg{-pk}} if $arg{-pk};

lib/ARSObject.pm  view on Meta::CPAN 

	foreach my $fn (sort keys %$flds) {
		next 	if !$flds->{$fn}->{fieldName} || !$flds->{$fn}->{COLUMN_NAME}
			|| !$flds->{$fn}->{TYPE_NAME};
		$fpk =$flds->{$fn}	if !$fpk && $flds->{$fn}->{IS_PK} 
					&& ($flds->{$fn}->{IS_PK} eq '1');
		$fid =$flds->{$fn}	if !$fid && $flds->{$fn}->{IS_PK} 
					&& ($flds->{$fn}->{IS_PK} eq '1');
		$fts =$flds->{$fn}	if !$fts && $flds->{$fn}->{IS_TIMESTAMP};
		push @flds, $flds->{$fn};
	}
	!$fpk && &{$s->{-die}}($s->efmt('PK not found','',undef,'dbidsrpl',$arg{-form}));
	$fts =undef if defined($arg{-timestamp}) && !$arg{-timestamp};
	# !$fts && &{$s->{-die}}($s->efmt('Timestamp not found','',undef,'dbidsrpl',$arg{-form}));
 }
 $s->dbi() if !$s->{-dbi};
 local $s->{-dbi}->{LongReadLen} =$s->{-dbi}->{LongReadLen} <= 1024 ? 4*64*1024 : $s->{-dbi}->{LongReadLen};
 my $vts =$fts && $s->dbiquery('SELECT max(' .$fts->{COLUMN_NAME} .') FROM ' .$tbc)->fetchrow_arrayref();
    $vts =$vts && $vts->[0];
 my $cts =0;
 if ($vts) {
	my $sql ='SELECT count(*) FROM ' .$tbc .' WHERE ' .$s->{-dbi}->quote_identifier($fts->{COLUMN_NAME}) .'=' .$s->{-dbi}->quote($vts);
	$cts =$s->dbiquery($sql)->fetchrow_arrayref();
	$cts =$cts && $cts->[0] ||0;

lib/ARSObject.pm  view on Meta::CPAN 

							if $ra
							&& ($f->{TYPE_NAME} eq 'float')
							&& defined($rd->{$f->{COLUMN_NAME}});
				$rw->{$f->{fieldName}} =!defined($rd->{$f->{COLUMN_NAME}})
							? $rd->{$f->{COLUMN_NAME}}
							: $f->{TYPE_NAME} eq 'datetime'
							? timestr($s, $rd->{$f->{COLUMN_NAME}})
							: $rd->{$f->{COLUMN_NAME}};
			}
			if ($rd->{_arsobject_delete}) {
				$rd->{_arsobject_insert} =$rd->{_arsobject_update} =undef;
				next	if $arg{-filter}
					&& !&{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},$rw,$rd);
				sleep($arg{-sleep} ||0);
				$cd++;
				$s->entryDel(-form=>$arg{-form}, -echo=>$arg{-echo}
						,-id=>$rd->{$fid->{COLUMN_NAME}});
			}
			elsif ($rd->{_arsobject_update}) {
				$rd->{_arsobject_insert} =$rd->{_arsobject_delete} =undef;
				next	if $arg{-filter}
					&& !&{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},$rw,$rd);
				$rw ={map {	!defined($rw->{$_}) && !defined($ra->{$_})
						? ()
						: !defined($rw->{$_}) ||!defined($ra->{$_})
						? ($_ => $rw->{$_})
						: $rw->{$_} ne $ra->{$_}
						? ($_ => $rw->{$_})
						: ()
						} keys %$rw}
					if $ra;
				if (scalar(%$rw)) {
					sleep($arg{-sleep} ||0);
					$cu++;
					$s->entryUpd(-form=>$arg{-form}, -echo=>$arg{-echo}
						,-id=>$rd->{$fid->{COLUMN_NAME}}
						, %$rw);
				}
			}
			elsif ($rd->{_arsobject_insert}) {
				$rd->{_arsobject_update} =$rd->{_arsobject_delete} =undef;
				next	if $arg{-filter}
					&& !&{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},$rw,$rd);
				sleep($arg{-sleep} ||0);
				$ci++;
				$s->entryIns(-form=>$arg{-form}, -echo=>$arg{-echo}
					, map {defined($rw->{$_}) ? ($_ => $rw->{$_}) : ()} keys %$rw);
			}
			my $sql = $rd->{_arsobject_insert} || $rd->{_arsobject_delete}
				? ('DELETE FROM ' .$tbc 
					.' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rd->{$fpk->{COLUMN_NAME}}))
				: ('UPDATE ' .$tbc .' SET '
					.join(', ', map { !exists($rd->{$_})
						? ()
						: ($s->{-dbi}->quote_identifier($_) .' =NULL')
						} '_arsobject_insert','_arsobject_update', '_arsobject_delete')
					.' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rd->{$fpk->{COLUMN_NAME}}));
			print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
			$s->{-dbi}->do($sql)
			|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
		}
		@rq =();
	}
 }	
 if ($arg{-ckdel}) {
	my $cnl ='';
	my $dbr =[];
	while ($dbr) {
	  my $sql ='SELECT ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) 
		.' FROM ' .$tbc

lib/ARSObject.pm  view on Meta::CPAN 

				} $s->query(-form=>$arg{-form}
				,-fields=>[$fpk->{fieldName}]
				,-echo=>$arg{-echo}
				,-query=>join(' AND '
					, $arg{-query} ? '(' .$arg{-query} .')' : ()
					, '(' .join(' OR ', map {"'" .$fpk->{fieldName} ."'=" .$s->arsquot($_)
						} @cnd) .')')
				);
			my @del =map {	$ars{$_}
					? ()
					: !$arg{-filter} || &{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},undef,$_)
					? $_
					: ()
					} @cnd;
			if (scalar(@del)) {
				$cnl =$del[$#del];
				$sql ="DELETE FROM $tbc WHERE "
					.join(' OR ', map {$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .'=' .$s->{-dbi}->quote($_)
							} @del);
				push @rms, $sql;
				$cd +=scalar(@del);

lib/ARSObject.pm  view on Meta::CPAN 

			if (scalar(@del)) {
				$dbq->finish();
				last;
			}
		}
	  }
	  foreach $sql (@rms) {
				print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
				$@ ='Unknown error';
				$s->{-dbi}->do($sql)
				|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
	  }
	}
 }
 if (!exists($arg{-ckupd}) || $arg{-ckupd}) {
	my $sqlm=0;
	local $s->{-strFields} =0;
	my $fpksql ='SELECT * FROM ' .$tbc .' WHERE ' .$fpk->{COLUMN_NAME} .'=';
	my $lm;
	if ($arg{-master} && $arg{-master_fk} && $fts) {
		my $mtb =$s->sqlname($arg{-master});

lib/ARSObject.pm  view on Meta::CPAN 

			}
		}
		my $sql ='SELECT max(d.' .$s->{-dbi}->quote_identifier($fts->{COLUMN_NAME}) .')'
				.', max(m.' .$s->{-dbi}->quote_identifier($mts) .')'
			.' FROM '
			.join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $mtb)
			." m, $tbc d"
			.' WHERE m.' .$s->{-dbi}->quote_identifier($mpk)
			.'=d.' .$s->{-dbi}->quote_identifier($mfk);
		my $mtv = $s->dbiquery($sql)->fetchrow_arrayref();
		print "$sql --> " .($mtv ? join(', ', map {$s->{-dbi}->quote(defined($_) ? $_ : 'undef')} @$mtv) : "'undef'") .";\n"
				if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
		$mtv =!$mtv ||!$mtv->[0] ||!$mtv->[1]
			? ''
			: $mtv->[0] lt $mtv->[1]
			? $mtv->[0]
			: $mtv->[1];
		$sql ='SELECT count(*) FROM '
			.join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $mtb)
			.' WHERE '
			.$s->{-dbi}->quote_identifier($mts) .'=' .$s->{-dbi}->quote($mtv);

lib/ARSObject.pm  view on Meta::CPAN 

				.'>=' .$s->{-dbi}->quote($mtv)
				.($mpv 
				 ? ' AND ' .$s->{-dbi}->quote_identifier($mpk)
					.'>=' .$s->{-dbi}->quote($mpv)
				 : '')
			: '')
			.' ORDER BY ' .$s->{-dbi}->quote_identifier($mts) .' ASC '
			.', ' .$s->{-dbi}->quote_identifier($mpk) .' ASC ';
		print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
		$lm =$s->{-dbi}->selectcol_arrayref($sql,{'MaxRows'=>$arg{-lim_rf}});
		return(&{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'selectcol_arrayref',$sql)))
			if !$lm && $s->{-dbi}->errstr;
		# print $s->dsquot($lm),"\n";
		# die('TEST')
		# -form=>'HPD:HelpDesk_AuditLogSystem'
		# ,-master=>'HPD:Help Desk', -master_pk=>'Entry ID',-master_fk=>'Original Request ID', -master_ts=>'Last Modified Date'
	}
	my ($rw, $rd) =({});
	my ($cs, $cw) =($cts,0);
	while ($lm ? scalar(@$lm) : 1) {
	  $cw++;

lib/ARSObject.pm  view on Meta::CPAN 

							: $s->{-dbi}->quote($rw->{$_->{fieldName}})
							))
						} @flds)
				.' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rw->{$fpk->{fieldName}});
			$cu++
		}
		if ($sql) {
			# local $s->{-dbi}->{LongTruncOk} =1;
			print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
			$s->{-dbi}->do($sql) 
			|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
		}
	  }
	  if (!$fts && ($cs == $cw *$arg{-lim_rf})) {
		sleep($arg{-sleep} ||0);
		next;
	  }
	  elsif ($lm) {
		sleep($arg{-sleep} ||0);
		next;
	  }
	  last;
	}
	if ($arg{-unused} && ($fts ? $vts : 1)) {
		my $sql ='DELETE FROM ' .$tbc .' WHERE ' 
			.dbidsqq($s
				, $vts && $fts ? '(' .$fts->{COLUMN_NAME} .'<' .$s->{-dbi}->quote($s->strtime($vts||0)) .') AND (' .$arg{-unused} .')' : $arg{-unused}
				, $s->{'-meta-sql'}->{$tbl});
		print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
		my $n=	$s->{-dbi}->do($sql) 
			|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
		$cd +=$n;
	}
 }
 join(', ', map {$_ ? $_ : ()} $ci && "new $ci", $cu && "upd $cu", $cd && "del $cd")
	||'up-to-date'
}


sub dbidsquery {	# DBI datastore - query data alike ARS
 my ($s, %arg) =@_;
 # -form => ARS form	|| -from => sql table name
 # -fields=> ARS fields || -select=>sql select list
 # -query=> ARS query	|| -where => sql where
 # -order => 
 # -filter=> undef
 # -undefs=>1
 # -strFields=>1|0
 my $m =$s->{'-meta-sql'}->{$s->sqlname($arg{-form})};
 my $sql =join(' ', 'SELECT'
	,(ref($arg{-fields})
		? join(', ', map {$s->{-dbi}->quote_identifier($m->{-fields}->{$_} || $m->{-ids}->{$_} || $_)
			} @{$arg{-fields}})
		: $arg{-fields} && ($arg{-fields} ne '*')
		? dbidsqq($s, $arg{-fields}, $m)
		: ($arg{-fields} ||$arg{-select} ||'*')
		)

lib/ARSObject.pm  view on Meta::CPAN 

					$i =!$i;
				}
				$r})
		: $arg{-order}
		? ('ORDER BY ' .$arg{-order})
		: '')
	);
 print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
 local $s->{-dbi}->{LongReadLen} =$s->{-dbi}->{LongReadLen} <= 1024 ? 4*64*1024 : $s->{-dbi}->{LongReadLen};
 my $h =$s->dbiquery($sql); 
 my $xu=exists($arg{-undefs}) && !$arg{-undefs};
 my $yc=$arg{-select} ||ref($arg{-fields}) 
	|| ($arg{-fields} && ($arg{-fields} eq '*'));
 my $ys=defined($arg{-strFields}) ? $arg{-strFields} : $s->{-strFields};
 local $s->{-strFields} =defined($arg{-strFields}) ? $arg{-strFields} : $s->{-strFields};
 my ($r, $r1, @r);
 while ($r =$h->fetchrow_hashref()) {
	$r1 ={map {	$xu && !defined($r->{$_})
			? ()
			: $m->{-cols}->{$_} && $m->{-cols}->{$_}->{fieldName} && $m->{-cols}->{$_}->{fieldId}
			? ($m->{-cols}->{$_}->{fieldName}

lib/ARSObject.pm  view on Meta::CPAN 

	$sf =~s/$q([^$q]+)$q\.$q([^$q]+)$q/!$s->{'-meta-sql'}->{-forms}->{$1} ? "?1$q$1${q}.$q$2$q" : $s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$1}}->{-fields}->{$2} ? $s->{-dbi}->quote_identifier($s->{'-meta-sql'}->{-forms}->{$1}) .'.' .$s->{-dbi}-...
	$sf =~s/$q([^$q]+)$q/$s->{'-meta-sql'}->{-forms}->{$1} ? ($s->{-sqlschema} ? $s->{-dbi}->quote_identifier($s->{-sqlschema}) .'.' : '') .$s->{-dbi}->quote_identifier($s->{'-meta-sql'}->{-forms}->{$1}) : $mh->{-fields}->{$1} ? $s->{-dbi}->quote_identi...
	return($sf);	
 }
 my $qs =$s->{-dbi}->quote('w') =~/^([^w]+)w/ ? $1 : "'";
 my $qi =$s->{-dbi}->quote_identifier('w') =~/^([^w]+)w/ ? $1 : '"';
 my $qsq=$s->{-dbi}->quote("'w") =~/^([^w]+)w/ ? $1 : "''";
 my $qiq=$s->{-dbi}->quote_identifier('"w') =~/^([^w]+)w/ ? $1 : '""';
 my $qit=$qi .'.' .$qi;
 my $sr ='';
 my $m =undef;
 while ($sf =~/^(.*?)(\Q$qs\E|\Q$qi\E)(.*)/) {
	if ($2 eq $qi) {
		$sr .=$1 .$2;
		$sf =$3;
		my ($st,$sn) =('','');
		while (1) {
			if (!($sf =~/^(.*?)(\Q$qiq\E|\Q$qit\E|\Q$qi\E)(.*)/)) {
				return($sr .($st ? $st .$qit : '') .$sn .$sf)
			}
			elsif ($2 eq $qiq) {

lib/ARSObject.pm  view on Meta::CPAN 

sub cgiconnect {# Connect CGI
 my $s =shift;
 no warnings;
 local $^W =0; 
 $ENV{HTTP_USER_AGENT} =$ENV{HTTP_USER_AGENT}||'';
 $ENV{PERLXS} ='PerlIS' if !$ENV{PERLXS} && ($^O eq 'MSWin32') && $0 =~/[\\\/]perlis\.dll$/i;
 eval('use CGI; 1')
	||return(&{$s->{-die}}($s->efmt('No CGI')));
 $s->{-cgi} =$CGI::Q =$CGI::Q =eval{CGI->new(@_)}
	||return($s->{-die}
		? &{$s->{-die}}($s->efmt($@, undef, undef, 'cgi'))
		: CORE::die($s->efmt($@, undef, undef, 'cgi')));
 $s->set(-die=>'CGI::Carp fatalsToBrowser') if !$s->{-die};
 return(&{$s->{-die}}($s->efmt($s->{-cgi}->{'.cgi_error'}, undef, undef, 'cgi')))
	if $s->{-cgi}->{'.cgi_error'};
 if (1) {	# parse parameters
		# __C_ change(d), 
		# __O_ open, __L_ listbox choise, __S_ set, __X_ close
		# __P_ previous value
		# __B_ button for javascript
	foreach my $p ($s->{-cgi}->param) {
		if ($p =~/^(.+?)__S_$/) {
			$s->{-cgi}->param($1, $s->{-cgi}->param("$1__L_"));
			$s->{-cgi}->param("$1__C_", 1);

lib/ARSObject.pm  view on Meta::CPAN 



sub smtpconnect {# Connect SMTP
 set(@_);	# (-smtphost) -> self->{-smtp}
 set($_[0],-die=>'Carp') if !$_[0]->{-die};
 my $s =shift;
 no warnings;
 local $^W =0; 
 eval('use Net::SMTP; 1') ||return(&{$s->{-die}}($@, $s->efmt('Net::SMTP')));
 $s->{-smtp} =eval {
		local $^W=undef; 
		eval("use Net::SMTP"); 
		$s->{-smtphost}
			? Net::SMTP->new($s->{-smtphost})
			: CORE::die($s->efmt('SMTP host name required'))
	};
 return(&{$s->{-die}}("SMTP host '" .($s->{-smtphost}||'') ."': $@\n")) 
	if !$s->{-smtp} ||$@;
 $s->{-smtp}
}

lib/ARSObject.pm  view on Meta::CPAN 

		$a{-data} .=$n .' ' .$a{$k} ."\cM\cJ";
	}
	$a{-data} .="MIME-Version: 1.0\cM\cJ";
	$a{-data} .='Content-type: '  .($a{-html} ? 'text/html' : 'text/plain')
			.'; charset=' .($a{-charset}||$s->charset())
			."\cM\cJ";
	$a{-data} .='Content-Transfer-Encoding: ' .($a{-encoding} ||'8bit') ."\cM\cJ";
	$a{-data} .="\cM\cJ";
	$a{-data} .=$a{-html} ||$a{-text} ||'';
 }
 local $^W=undef;
 $s->smtp->mail($a{-sender} =~/<\s*([^<>]+)\s*>/ ? $1 : $a{-sender})
	||return(&{$s->{-die}}("SMTP sender \'" .$a{-sender} ."' -> " .($s->smtp->message()||'?')));
 $s->smtp->to(ref($a{-recipient})
		? (map { !$_ ? () : /<\s*([^<>]+)\s*>/ ? $1 : $_ } @{$a{-recipient}})
		: $a{-recipient}, {'SkipBad'=>1}) # , {'SkipBad'=>1}
	|| return(&{$s->{-die}}("SMTP recipient \'" 
		.(ref($a{-recipient}) ? join(', ', (map { !$_ ? () : /<\s*([^<>]+)\s*>/ ? $1 : $_ } @{$a{-recipient}})) : $a{-recipient}) ."' -> " .($s->smtp->message()||'?')));
 $s->smtp->data($a{-data})
	||return(&{$s->{-die}}("SMTP data '" .$a{-data} ."' -> " .($s->smtp->message()||'?')));
 my $r =$s->smtp->dataend()
	||return(&{$s->{-die}}("SMTP dataend -> " .($s->smtp->message()||'?')));
 $r ||1;
}


sub soon {	# Periodical execution of this script
		# (minutes ||sub{}, ?log file, ?run command, ?soon command)
		# minutes: undef - clear sched, run once || sub{} -> number
		# log file: empty || full file name || var file name
		# run  command: empty || 'command line' || [command line] || sub{}
		# soon command: empty || 'command line' || [command line] || []
		# empty run command - only soon command will be scheduled
		# empty soon command - sleep(minutes*60) will be used
		# !defined(minutes) - soon command will be deleted from schedule 
		#	and run command will be executed once
		# [soon command,... [arg,...],...] - schedule cleaning hint:
		#	join(' ',@{[soon,...arg]}) used to clean schedule
		#	join('', @{[arg,...]}) used in soon command

lib/ARSObject.pm  view on Meta::CPAN 

 }
 1
}


sub cfpinit {	# Field Player: init data structures
 my ($s) =@_;	# (self) -> self
 $s->{-fphc} ={};
 $s->{-fphd} ={};
 my $dh ={};
 my $dp =undef;
 my $ah ={};
 my $ak;
 my $bf =undef;
 foreach my $f (@{$s->{-fpl}}) {
	if (ref($f) && $f->{-key} && $f->{-namecgi}) {
		$ak =$f->{-namecgi};
		last
	}
 }
 foreach my $f (@{$s->{-fpl}}) {
	if (ref($f) ne 'HASH') {
		if (!defined($dp)) {
			$dp =$f ||'-unknown';
		}
		elsif (!defined($f)) {
			delete $dh->{$dp};
			delete $dh->{-record} if $dp eq '-formdb';
			$dp =undef;
		}
		else {
			$dh->{$dp} =$f;
			delete $dh->{-record} if $dp eq '-formdb';
			$dp =undef;
		}
	}
	else {
		@$f{keys %$dh} =values %$dh;
		if ($f->{-metadb} && $f->{-formdb} && $s->{-meta} && $s->{-meta}->{$f->{-formdb}}) {
			my $fm =$f->{-metadb};
			$fm =	($fm =~/^\d+$/ 
					? $s->{-meta}->{$f->{-formdb}}->{-fldids}->{$fm}
					: $s->{-meta}->{$f->{-formdb}}->{-fields}->{$fm})
				|| &{$s->{-die}}($s->efmt('Field not found',$s->{-cmd},undef,'cfpinit',$f->{-formdb},$f->{-metadb}));
			$f->{-name}   =$fm->{fieldName} if !$f->{-name};
			$f->{-namelbl}=$fm->{fieldLbll} if !exists($f->{-namelbl});
			$f->{-values} =schvals($s, $f->{-formdb}, $fm)
				if !($f->{-values} ||$f->{-labels})
				&& schvals($s, $f->{-formdb}, $fm);
			$f->{-labels} =schlblsl($s, $f->{-formdb}, $fm)
				if !$f->{-labels}
				&& schlbls($s, $f->{-formdb}, $fm);
			$f->{-value}  =$fm->{defaultVal}
				if !exists($f->{-value})

lib/ARSObject.pm  view on Meta::CPAN 

		}
		elsif (ref($f->{-action}) ||($f->{-action} =~/^../)) {
		}
		else {
			$f->{-used} =$ah->{$f->{-namecgi}}->{-used}
				if !exists($f->{-used})
				&& exists($ah->{$f->{-namecgi}}->{-used});
			$f->{-unused} =$ah->{$f->{-namecgi}}->{-unused}
				if !exists($f->{-unused})
				&& exists($ah->{$f->{-namecgi}}->{-unused});
			$ah->{$f->{-namecgi}}->{-widget} =undef
				if !exists($ah->{$f->{-namecgi}}->{-widget});
		}
		if (exists($f->{-used}) ||exists($f->{-unused})) {
		}
		elsif ($ak && ($f->{-action}||$f->{-preact})
		&& (($f->{-action}||$f->{-preact}) =~/^(?:entryUpd|entryDel|entry|vfentry|vfhash)$/)) {
			$f->{-used} =sub{$_[0]->cgipar($ak)}
		}
		else {
			$f->{-used} =1
		}
		$f->{-widget} =undef
			if $f->{-preact} && !exists($f->{-widget});
		$bf =1
			if $f->{-action} && ($f->{-action} =~/^\d$/);
	}
 }
 if (!$bf) {
	my @bl;
	foreach my $f (@{$s->{-fpl}}) {
		next	if ref($f) ne 'HASH';
		next	if !$f->{-namecgi} || !$f->{-action};
		$f->{-widget} =undef;
		next	if exists($f->{-computed}) || exists($f->{-value})
			|| !$ah->{$f->{-namecgi}};
		push @bl, {%$f, -action=>1};
		delete $bl[$#bl]->{-widget};
		delete $ah->{$f->{-namecgi}};
	}
	push @{$s->{-fpl}}, @bl;
 }
 $s
}

lib/ARSObject.pm  view on Meta::CPAN 

	: ($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]});
 !$f
 ? $_[0]->{-cgi}->param($_[1])
 : !$f->{-namecgi} || !defined($_[0]->{-cgi}->param($f->{-namecgi}))
 ? (exists($f->{-computed})
	? (ref($f->{-computed}) eq 'CODE'
		? &{$f->{-computed}}($_[0], $f)
		: ref($f->{-computed}) eq 'ARRAY'
		? cfpv($_[0], @{$f->{-computed}})
		: $f->{-computed})
	: undef)
 : $_[0]->{-cgi}->param($f->{-namecgi})
}


sub cfpvl {	# Field Player: field values list
		# (self, field || fieldname) -> [list]
 my $f =ref($_[1])
	? $_[1]
	: ($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]});
 !$f

lib/ARSObject.pm  view on Meta::CPAN 

 defined($v) ? $v : cfpvd(@_)
}


sub cfpvd {	# Field Player: field default value
		# (self, field || fieldname) -> value
 my $f =ref($_[1])
	? $_[1]
	: ($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]});
 !$f
 ? undef
 : exists($f->{-computed})
 ? (	  ref($f->{-computed}) eq 'CODE'
	? &{$f->{-computed}}($_[0], $f)
	: ref($f->{-computed}) eq 'ARRAY'
	? cfpvv($_[0], @{$f->{-computed}})
	: $f->{-computed})
 : !exists($f->{-value})
 ? ($f->{-values} ||$f->{-labels} ? cfpvl($_[0], $f)->[0] : undef)
 : ref($f->{-value}) eq 'CODE'
 ? &{$f->{-value}}($_[0], $f)
 : ref($f->{-value}) eq 'ARRAY'
 ? cfpvv($_[0], @{$f->{-value}})
 : $f->{-value}
}


sub cfpvp {	# Field Player: field previous value
		# (self, field || fieldname) -> value

lib/ARSObject.pm  view on Meta::CPAN 


sub cfpaction {	# Field Player: execute action
		# (self, {action}||'action'
		# , '-preact'||'-action', {key field}) -> success
 my ($s, $act, $ord, $rp, $f) =@_;
 my $r =1;
 my $af=ref($act) eq 'HASH' ? $act : {};
 my $ae=ref($act) eq 'HASH' ? $act->{$ord} : $act;
 my $frm =$f->{-formdb}|| $af->{-formdb} ||'';
 my $frn =$f->{-record}|| $af->{-record} ||'';
 my $frk =undef;
 my $ffc =sub{	my $f =$_[1];
		!ref($f)
		|| !$f->{-namedb} || $f->{-key}
		|| !$f->{-formdb} || ($f->{-formdb} ne $frm)
		|| (($f->{-record}||'') ne $frn)
		};
 my $vy  =0;
 my $fvu =sub{	return(undef)
			if (ref($_[1]->{-values}) eq 'ARRAY') 
			&& !scalar(@{$_[1]->{-values}});
		my $v =cfpvv(@_);
		$v =undef  if defined($_[1]->{-undef}) && defined($v) && ($_[1]->{-undef} eq $v);
		$vy=1 if defined($v) && ($v ne '') && (!$_[1]->{-master} ||$_[1]->{-key});
		$v =cfpvv($_[0], $_[1]->{-master}) if $_[1]->{-master} && !$_[1]->{-key};
		return($v) if !$_[2] || (defined($_[1]->{-vftran}) && !$_[1]->{-vftran});
		!defined($v)
		? $v
		: (ref($_[1]->{-labels}) eq 'HASH') && exists($_[1]->{-labels}->{$v})
		? $_[1]->{-labels}->{$v}
		: $v;
		};
 local $_;
 if ($frn || $s->{-fpbn}) {
	my $n =$frn =~/^(.+?)\d+$/ ? $1 : $frn;
	if ($n ne ($s->{-fpbn}||'')) {
		$s->{-fpbn} =$n;	# buffer values
		$s->{-fpbv} =undef;     # buffer name == record common name
		if ($ae =~/^(?:vfentry|entry)$/) {
			foreach my $ff (@{$s->{-fpl}}) {
				next if &$ffc($s, $ff) || !$ff->{-master};
				$frk =$ff;
				last;
			}
		}
	}
 }
 if (!$ae) {

lib/ARSObject.pm  view on Meta::CPAN 

			: ($_->{-namedb} => cfpv($s, $_))
			} @{$s->{-fpl}}}
		)}
 }
 elsif ($ae =~/^(?:vfentry|entry)$/ && ref($s->{-fpbv})) {
	$r =shift @{$s->{-fpbv}} if scalar(@{$s->{-fpbv}});
	$r ={} if !$r;
 }
 elsif ($ae eq 'vfentry') {	# -preact
	my $fs =$f->{-vfname} ||$af->{-vfname};
	my $fn =undef;
	my $fv =undef;
	if ($frk && $fs && ($fn =$frk->{-namedb}) && defined($fv=cfpv($s, $frk->{-master}))) {
		$s->{-fpbv} =$f->{-namedb}
			? $s->vfdata($fs, sub{defined($_->{$fn}) && ($_->{$fn} eq $fv)})
			: [];
		$r =shift @{$s->{-fpbv}} if $s->{-fpbv} && scalar(@{$s->{-fpbv}});
		$r ={} if !$r;
	}
	elsif ($fs) {
		$r =undef;
		if (defined($fv=cfpv($s, $f))) {
			$fn =$f->{-namedb}
		}
		elsif ($af->{-namedb} && ($fv =cfpv($s, $af))) {
			$fn =$af->{-namedb};
		}
		elsif ($fn =cfpnd($s, cfpv($s, $af))) {
			$fv =cfpv($s, $fn)
		}
		if ($fn && defined($fv)) {
			$r =undef;
			my $fa =$s->vfdata($fs);
			foreach my $e (@$fa) {
				next if !defined($e->{$fn}) || ($e->{$fn} ne $fv);
				$r =$e;
				last
			}
			$@="Not found '$fn'=\"$fv\""
				if !$r;
		}
		else {

lib/ARSObject.pm  view on Meta::CPAN 

			? "Key '$fn' not defined at vfentry('$fs')"
			: "Key not defined at vfentry('$fs')"
		}
	}
	else {
		$@ ="Nothing to do at 'vfentry', '-vfname' not defined"
	}
 }
 elsif ($ae eq 'vfhash') {	# -preact
	my $fs =$f->{-vfname} ||$af->{-vfname};
	my $fn =undef;
	my $fv =undef;
	if (defined($fv=cfpv($s, $f))) {
		$fn =$f->{-namedb}
	}
	elsif ($af->{-namedb} && ($fv =cfpv($s, $af))) {
		$fn =$af->{-namedb};
	}
	elsif ($fn =cfpnd($s, cfpv($s, $af))) {
		$fv =cfpv($s, $fn)
	}
	$r =undef;
	if (!$fs) {
		$@ ="Nothing to do at 'vfhash', '-vfname' not defined"
	}
	elsif (!$fn) {
		$@ ="Key not defined at 'vfhash'"
	}
	elsif (!defined($fv)) {
		$@ ="Key '$fn' not defined at 'vfhash'"
	}
	else {
		$r =$s->vfhash($fs, $fn, $fv);
		$@="Not found '$fn'=\"$fv\""
			if !$r;
	}
 }
 elsif ($ae eq 'entry') {	# -preact
	my $fn =undef;
	my $fv =undef;
	if (!$frm) {
		$r =undef;
		$@ ="Form not defined"
	}
	elsif ($frk && ($fn=$frk->{-namedb}) && ($fv =cfpv($s, $frk->{master}))) {
		$s->{-fpbv} =$f->{-namedb}
			? eval{$s->connect()
				&& $s->query(-form=>$frm
				,-fields=>'*'
				,-where=>"'$fn'=" .$s->arsquot($fv))}
			: [];
		if ($s->{-fpbv}) {
			$r =shift @{$s->{-fpbv}} if scalar(@{$s->{-fpbv}});
			$r ={} if !$r;
		}
		else {
			$r =undef
		}
	}
	elsif ($f && ($fv =cfpv($s, $f))) {
		$r =eval{$s->connect()
				&& $s->entry(-form=>$frm
				,-id=>$fv)};
	}
	elsif (   (($fn =$af->{-namedb}) && defined($fv =cfpv($s, $af)))
	       || (($fn =cfpnd($s, cfpv($s, $af))) && defined($fv =cfpv($s, $fn)))
		) {

lib/ARSObject.pm  view on Meta::CPAN 

				&& $s->query(-form=>$frm
				,-fields=>'*'
				,-where=>"'$fn'=" .$s->arsquot($fv))};
		if ($r) {
			$r =shift @$r;
			$@ ="Not found '$fn'=\"$fv\""
				if !$r
		}
	}
	else {
		$r =undef;
		$@ ="Key not defined"
	}
 }
 elsif ($ae eq 'entryNew') {	# -preact
	$r =eval{$s->connect()
		&& $s->entryNew(-form => $frm)}
		if $frm;
 }
 elsif ($ae eq 'entryIns') {	# -action
	my $fs =$f->{-vfname} ||$af->{-vfname};

lib/ARSObject.pm  view on Meta::CPAN 

	elsif (($af->{-vfclear} || $f->{-vfclear}) && $s->{"${fs}-calc"}) {
		$s->vfclear($fs);
	}
	elsif (($af->{-vfrenew} || $f->{-vfrenew}) && $s->{"${fs}-store"}) {
		eval{$s->vfclear($fs); $s->vfrenew($fs)}
	}
	elsif ($af->{-vfedit} || $f->{-vfedit}) {
		my $fn =$f->{-namedb} ||$af->{-namedb};
		my $fv =cfpv($s, $f);
		my $fa =$s->vfdata($fs);
		my ($i,$j)  =(0, undef);
		foreach my $e (@$fa) {
			if (defined($e->{$fn}) && ($e->{$fn} eq $fv)) {
				$j =$i;				
				last;
			}
			$i++
		}
		splice(@$fa, $i, 1);
		$s->vfstore($fs);
		$s->vfclear($fs);

lib/ARSObject.pm  view on Meta::CPAN 

 my ($s, $cmsg, $cfld, $cfld0, $cfld1) =@_;
 my $hmsg =ref($cmsg) eq 'HASH' 
	? $cmsg 
	: ($s->{-lang} ||'') =~/^ru/i
	? {'Error'=>'Îøèáêà', 'Warning'=>'Ïðåäóïðåæäåíèå', 'Success'=>'Óñïåøíî'
		,'Executing'=>'Âûïîëíåíèå', 'Done'=>'Âûïîëíåíî'}
	: {};
 $cmsg =sub{"\n<br /><font style=\"font-weight: bolder\""
		.($_[1] =~/^(?:Error|Warning)/ ? ' color="red"' : '')
		.'>'
		.(defined($_[1]) ? $_[0]->{-cgi}->escapeHTML($hmsg->{$_[1]} ||$_[1]) : 'undef')
		.": "
		.(defined($_[2]) ? $_[0]->{-cgi}->escapeHTML($hmsg->{$_[2]} ||$_[2]) : 'undef')
		."</font>"
		# 'Error', 'Warning',
		# 'Executing', 'Done'('Success', 'Error')
		}
	if !$cmsg || (ref($cmsg) ne 'CODE');
 my $emsg =sub{	
		$CGI::Carp::CUSTOM_MSG
		? &$CGI::Carp::CUSTOM_MSG($_[1])
		: print(&$cmsg($_[0], 'Error', $_[1]))
		};

lib/ARSObject.pm  view on Meta::CPAN 

		$aec =cfpvv($s, $f);
	}
	if ($f->{-key} && $act && !$err) {
		$arv =1;
		foreach my $a (@$act) {
			$arv =cfpaction($s, $a, '-preact', $arv, $f);
			next if $arv;
			$err =$@;
			last
		}
		$act =undef;
		if (!$arv) {
			&$emsg($s, $err ||"Unknown 'cfpaction' error");
			$err =1;
			last;
		}
	}
	if ($f->{-key}) {
		$act =undef;
	}
	next if !cfpused($s, $f);
	my $fn =cfpn($s, $f);
	if (!$f->{-reset}
		? undef
		: ref($f->{-reset}) eq 'CODE'
		? &{$f->{-reset}}($s, $f)
		: ref($f->{-reset}) eq 'ARRAY'
		? grep {cfpvcc($s, $_)} @{$f->{-reset}}
			# ??? read from URL interpreted as changed listbox
		: $f->{-reset}
		? cfpvcc($s, $f->{-reset})
		: undef
		) {
		$s->{-cgi}->delete($fn);
	}
	my $fv =exists($f->{-computed})
		? (ref($f->{-computed}) eq 'CODE'
			? &{$f->{-computed}}($s, $f)
			: ref($f->{-computed}) eq 'ARRAY'
			? cfpvv($s, @{$f->{-computed}})
			: $f->{-computed})
		: cfpvv($s, $f);

lib/ARSObject.pm  view on Meta::CPAN 

				if !defined($s->{-cgi}->param("${fn}__PV_"));
		}
		else {
			$s->{-cgi}->delete($fn);
		}
	}
	foreach my $q ('-change', '-changelb') {
		next if !$f->{$q};
		last if !cfpvcc($s, $f);
		my $c =ref($f->{$q}) eq 'CODE' ? &{$f->{$q}}($s, $f, $_ =$fv) : $f->{$q};
		$c =ref($c) ne 'HASH' ? undef : ref($c->{$fv}) eq 'HASH' ? $c->{$fv} : $c;
		if (ref($c) eq 'HASH') {
			foreach my $k (keys %$c) {
				next if $k =~/^-/;
				defined($c->{$k})
				? $s->{-cgi}->param(cfpn($s, $k)
					, ref($c->{$k}) eq 'CODE'
					? &{$c->{$k}}($s, $f, $_ =$fv)
					: $c->{$k}
					)
				: $s->{-cgi}->delete(cfpn($s, $k))
			}
		}
	}
	if (my $ev =!$aec || !$f->{-error}
		? undef
		: ref($f->{-error}) eq 'CODE'
		? &{$f->{-error}}($s, $f, $_ =$fv, cfpvp($s, $f), $aec)
		: !ref($f->{-error}) && (!defined($fv) || ($fv eq ''))
		? $f->{-error}
		: undef
		) {
		print &$cmsg($s, 'Error', "'" .$f->{-namelbl} ."' - $ev");
		$err =1;
	}
	if (my $ev =!$f->{-warn}
		? undef
		: ref($f->{-warn}) eq 'CODE'
		? &{$f->{-warn}}($s, $f, $_ =$fv, cfpvp($s, $f), $aec)
		: !ref($f->{-warn}) && (!defined($fv) || ($fv eq ''))
		? $f->{-warn}
		: undef
		) {
		print &$cmsg($s, 'Warning', "'" .$f->{-namelbl} ."' - $ev");
	}
 }
 return(undef)
	if $err;
 $act =	$acf =$arv =undef;
 foreach my $f (@{$s->{-fpl}}) {
	next	if (ref($f) ne 'HASH')
		|| (exists($f->{-used}) && !$f->{-used});
	next if !cfpused($s, $f);
	if ($f->{-action} && ($f->{-action} !~/^\d$/) && cfpvv($s, $f)) {
		$acf =1;
		$act =[] if !$act;
		push @$act, $f
	}
	if ($f->{-key} && $act && !$err) {
		$arv =1;
		foreach my $a (@$act) {
			print &$cmsg($s, 'Executing', ($a->{-namelbl} ||$a->{-namecgi} ||'') .' ', $arv)
				if $a->{-namelbl} ||$a->{-namecgi};
			$arv =cfpaction($s, $a, '-action', $arv, $f);
			next if $arv;
			$err =$@;
			last;
		}
		$act =undef;
		if (!$arv) {
			&$emsg($s, $err ||"Unknown 'cfpaction' error");
			$err =1;
			last;
		}
	}
	if ($f->{-key}) {
		$act =undef;
	}
 }
 if ($acf) {
	print &$cmsg($s, 'Done', $err ? ('Error', $@) : ('Success', $arv))
 }
 return(undef)
	if $err;
 return(1)
	if $acf;
 foreach my $f (@{$s->{-fpl}}) {
	next	if (ref($f) ne 'HASH')
		|| (exists($f->{-used}) && !$f->{-used});
	next if exists($f->{-widget}) && !defined($f->{-widget});
	next if !$f->{-namecgi};
	my $u =cfpused($s, $f);
	next if $u && !($f->{-hidden} ||((ref($f->{-values}) eq 'ARRAY') && !scalar(@{$f->{-values}})));

lib/ARSObject.pm  view on Meta::CPAN 

		: ref($f->{-widget1}) eq 'CODE'
		? &{$f->{-widget1}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
		: $f->{-widget1})
	);
 }
 if ($bb) {
	print &$cfld($s, {}, $bb);
	$bb ='';
 }
 print ref($cfld1) ? &{$cfld1}($s) : $cfld1;
 $err ? undef : 1
}

lib/ARSObject.pod  view on Meta::CPAN 

=item CGI Form Presenter

C<-fpl> => [-formdb=>'...',-record=>'...', {action field},.. {view/edit field},.., {button field},..}]

C<-fphc> => {'cgi field name' => {field definition},..}

C<-fphd> => {'db field name' => {field definition},..}

C<cfprun>, C<cfpaction>, C<cfpv>, C<cfpvv>, C<cfpvl>, C<cfpvp>

* action field: C<-name>.., C<-preact> || C<-action>, C<-widget>=>undef, C<-used>=>condition sub{}

* key field: C<-name>.., C<-key>=>1, C<-readonly>=>1

* text: C<-widget>=>'html'

* edit field: C<-name>..,

* computed: C<-name>.., C<-computed>=>sub{}

* readonly: C<-name>.., C<-readonly>=>1

lib/ARSObject.pod  view on Meta::CPAN 

C<-preact> || C<-action> => 'action name' || action sub{} -> success

C<-vfname> => 'name', C<-vfrenew>, C<-vfedit>, C<-vftran> => boolean

C<-key> => boolean

C<-master> => 'field name'

C<-computed>, C<-value> => value || ['field from'] || sub{} -> value

C<-undef> => value

C<-values> => [value,..] || sub{}, C<-labels> => {value => label,..} || sub{}; C<-lbtran>, C<-lbadd> => boolean

C<-reset> => 'field name' || ['field',...] || condition sub{}

C<-change> => {set field values}

C<-error>, C<-warn> => sub{} -> 'text'

C<-widget> => {definitions for cgi field in the C<Utility Objects>} || html || sub{}->html

lib/ARSObject.pod  view on Meta::CPAN 

May be several actions with the same C<-namecgi>.
1 - action button, it should to be at the bottom of the form.
For 'entrySave' action, 'entryUpd' is used when non-empty key value,
'entryDel' otherwise with non-empty previous key value.

See also C<-preact>.


=item -cgi

	=> undef || CGI object

(C<Utility Objects>)
L<CGI|CGI> utility object.
See also C<cgi> method.



=item -change

	=> not exists

lib/ARSObject.pod  view on Meta::CPAN 


	=> not exists || value || [field name] || sub{}({self},{field}) -> value

(C<CGI Form Presenter - Field Definitions>)
Computed field value evaluator.
See also C<-value>.


=item -cpcon

	=> undef || sub{}(self, arg,...) -> translated

(C<Error Processing and Echo>)
Translation sub{} for error messages and C<-echo> printout.
I.e. sub{$_[0]->C<cptran>('ansi'=>'oem',@_[1..$#_])}


=item -ctrl

	=> undef || ARS control struct

(C<Connection>)
ARS control struct from ARS::ars_Login()



=item -dbi

	=> undef || DBI object

=item -dbiconnect

	=> undef || connection string || [connect args]

(C<Utility Objects>)
L<DBI|DBI> utility object and connect specification to create it.
See also C<dbi> and C<dbiconnect> methods.



=item -die

	=> undef || sub{}

	=> set(-die => 'Carp' || 'CGI::Carp' || 'CGI::Carp qw(fatalsToBrowser warningsToBrowser)' || 'CGI::Die')

(C<Error Processing and Echo>)
Error die sub{}.
The most C<Methods> dies when error.
Call C<set>(C<-die> => 'Carp') to use L<Carp|Carp> module.
Call C<set>(C<-die> => 'CGI::Carp fatalsToBrowser') to use L<CGI::Carp|CGI/Carp> module.

See also C<-diemsg>, C<-warn>, C<-cpcon>


=item -diemsg

	=> undef || sub{}(string)

Message for C<-die>, alike L<CGI::Carp|CGI/Carp>::set_message()



=item -echo

	=> 0 | 1

(C<Error Processing and Echo>)

lib/ARSObject.pod  view on Meta::CPAN 


=item -meta-min

(C<Metadata>)

Used by C<arsmetamin> internally.


=item -meta-sql

	=> undef || {SQL Data Store metadata}

(C<Metadata>, C<SQL Data Store Methods>, C<Variable files>)
SQL Data Store metadata loaded or refreshed by C<arsmetasql>()/C<sqlname>():

{tableName}->{-cols}->{sqlName}=>{fieldName, sqlName,...}

{tableName}->{-fields}->{fieldName}=>sqlName

{tableName}->{-ids}->{fieldId}=>sqlName

lib/ARSObject.pod  view on Meta::CPAN 

(C<CGI Form Presenter - Field Definitions>)
Action to execute before the form performance,
should be at the top of the form, before C<-key> fields.
May be several actions with the same C<-namecgi>.
Alternative key field name may be passed as L<CGI|CGI>->param(action-name).
See alco C<-action>.


=item -pswd

	=> undef || ''

(C<Connection>)
ARS password string to login with


=item -record 

	=> 'record name' || 'nameRowNumber'

(C<CGI Form Presenter - Field Definitions>)

lib/ARSObject.pod  view on Meta::CPAN 


	=> not exists || 'field name' || ['field name',..] || sub{}({self}, {field})

(C<CGI Form Presenter - Field Definitions>)
Condition to reset field value.
If C<-values> and field value unfound, it will be reset also.


=item -schema

	=> undef || [form name, form name...]

(C<Metadata>)
ARS forms or schemas to use.
Metadata will be loaded to C<-meta> and may be cached with C<vfname>(C<-meta>)
if C<-schgen>.


=item -schfdo

	=> 0 || 1

lib/ARSObject.pod  view on Meta::CPAN 


	0 - get metadata from server, do not use cache file.
	1 - generate cache file if not exists, else load this file.
	2 - renew schema definitions using timestamps.
	3 - renew schema always.
	[schema,...] - list of schemas to renew.


=item -smtp

	=> undef || Net::SMTP object

=item -smtphost

	=> undef || SMTP host name


(C<Utility Objects>)
L<Net::SMTP|Net/SMTP> utility object and connect specification to create it.
See also C<smtp> and C<smtpconnect> methods.


=item -sqlname

	=> undef || sub{}(self, ARS name) -> SQL name

(C<SQL Data Store Methods>)
sub{} to escape ARS name to the SQL name, 
may be used instead of C<-sqlntbl> and C<-sqlncol>.
See also C<-sqlninc>.
See 'sub sqlnesc' in the source code as an example.


=item -sqlncol

	=> undef || sub{}(self, ARS field name) -> SQL col name

(C<SQL Data Store Methods>)
sub{} to escape ARS field name to the SQL column name, see also C<-sqlntbl>, C<-sqlninc>.
See 'sub sqlnesc' in the source code as an example.


=item -sqlninc

	=> undef || sub{}(self, SQL name) -> SQL name incremented

(C<SQL Data Store Methods>)
sub{} to increment SQL name, used after C<-sqlname>/C<-sqlntbl>/C<-sqlncol>
when the same SQL name already exists.
See 'sub sqlninc' in the source code as an example.


=item -sqlntbl

	=> undef || sub{}(self, ARS form name) -> SQL table name


(C<SQL Data Store Methods>)
sub{} to escape ARS form name to the SQL table name, see also C<-sqlncol>, C<-sqlninc>.
See 'sub sqlnesc' in the source code as an example.


=item -sqlschema

	=> undef || SQL schema name

(C<SQL Data Store Methods>)
SQL schema name for C<dbidsmetasync>(), C<dbidsrpl>(), C<dbidsquery>().


=item -storable

=item -meta-storable

=item <-vfname>-storable

lib/ARSObject.pod  view on Meta::CPAN 


(C<Variable files>)
Use L<Storable|Storable> module for variable files, metadata file, or another particular file?
Or L<Data::Dumper|Data/Dumper> will be used.
See also C<vstore>().



=item -srv

	=> undef || 'ARS server name'

(C<Connection>)
ARS server name to connect


=item -strFields

	=> 1 || 0 || 2

(C<ARS methods>)
Translate ARS field values using metadata and conversion sub{}s.
1 - using 'enumLimits' and C<strtime>/C<timestr>('yyyy-mm-dd hh:mm:ss'), 
2 - using at first localisation metadata for enum fields ('fieldLbvl').



=item -undef

	=> not exists || value 

(C<CGI Form Presenter - Field Definitions>)
Field value to be treated as undef or null for database.
See also C<-value>.



=item -used

	=> not exists == 1 || boolean || 'field name' || ['field name',..] 
	|| sub{}({self}, {field})

=item -unused

	=> not exists == 0 || boolean || 'field name' || ['field name',..]
	|| sub{}({self}, {field})

(C<CGI Form Presenter - Field Definitions>)
Condition to use or unuse field in the screen and actions.


=item -usr

	=> undef || 'ARS user name'

(C<Connection>)
ARS user name to login under



=item -value

	=> not exists || value || [field name] || sub{}({self},{field}) -> value

lib/ARSObject.pod  view on Meta::CPAN 


C<-vfrenew> - renew variable file after 'entryIns' || 'entryUpd' || 'entryDel'

C<-vfedit> - update variable file after 'entryIns' || 'entryUpd' || 'entryDel'

C<-vftran> - translate value with C<-labels> for variable file


=item -warn

	=> undef

(C<Error Processing and Echo>)
Error warn sub{}.
Call C<set>(C<-die> => 'Carp') to use L<Carp|Carp> module,
or C<set>(C<-die> => 'CGI::Carp') to use L<CGI::Carp|CGI/Carp> module.
See also C<-cpcon>.


=item -warn

lib/ARSObject.pod  view on Meta::CPAN 

	|| 'warning text for empty field'

(C<CGI Form Presenter - Field Definitions>)
Field value warning evaluator.
See also C<-error>.



=item -warnmsg

	=> undef || sub{}(string)

Message for C<-warn>, alike C<-diemsg>.



=item -widget

	=> not exists || undef == skip || 'html'
	|| sub{}({self}, {field}, value, previous value) -> html
	|| {option=>value,..}

(C<CGI Form Presenter - Field Definitions>)
Definition of html field to display (C<Utility Objects>):

	not exists - use default widget,
	undef - field not included in form,
	'html' - html to display,
		hidden field with previous value added if '-namecgi'
	sub{} -> html to display,...
	{option=>value,..} - parameters for 'cgi...' or 'CGI' field

Field definitions may be used also to generate default widget:
C<-action> => 1;
C<-labels>, C<-values>;
C<-disabled>, C<-readonly>, C<-hidden>, C<-onchange> => boolean.

lib/ARSObject.pod  view on Meta::CPAN 



=item dbidsrpl (-param => value)

(C<SQL Data Store Methods>)

Replicate ARS data to the SQL Data Store.
Uses C<dbi>(), C<-meta-sql>, C<-sqlschema>.
Parameters:

-echo => undef || 0 || 1

-form => ARS form name

-fields => undef || '*' || fields to replicate, alike C<query>(-fields)

-query => undef || ARS query string

-filter => undef || filter sub{}(self, {args}, {-meta-sql}->{tableName}, {ARS record}, {Data Store record}) -> allow

-lim_rf => undef || max number of records read from ARS, C<query>(-limit).
The number of the records fetched really may be incremented by counting timestamps duplicated.
Without timestamps, additional queries will be invoked when '-lim_rf' records fetched.

-lim_or => undef || max number of 'OR keyField=keyValue' pairs

-pk => undef || primary key ARS field name, default is obtained from C<-meta-sql>

-timestamp => undef || 0 || 'Modified Date' timestamp ARS field name, default is obtained from C<-meta-sql>

-ckpush => undef || 1 || 0 - insert, update, delete ARS records according to '_arsobject_insert', '_arsobject_update', '_arsobject_delete' column values.

-ckdel => undef || 0 || 1 - check records deleted from ARS and replicate deletions to the Data Store,
this is expensive and slow, so default if off.

-ckupd => undef || 1 || 0 - check and replicate updates from ARS to the Data Store,
based on timestamps of records if availeble

-unused => undef || SQL where clause part to delete unused records from Data Store table. "ARS field name"s and "ARS form name"s may be used.

-sleep => undef || seconds to L<perlfunc::sleep|perlfunc> between calls to ARS.



=item dbidsquery (-param => value) -> ({fieldName => fieldValue,...},...)

(C<SQL Data Store Methods>)

Query data from SQL Data Store.
Uses C<dbi>(), C<-meta-sql>, C<-sqlschema>.
Any C<dbi>() method may be used for SQL Data Store, 
but C<dbidsquery> understands "ARS form name"s and "ARS field name"s
in addition to "sql table name"s and "sql column name"s.
Records are returned as hash refs with ARS field names available,
otherwise SQL column names.
Parameters:

-echo => undef || 0 || 1

-form => ARS form name

-fields => undef || '*' || 'SQL SELECT clause' || [fieldName ||fieldId ||colName,...].
Empty value requests all fields, '*' - all fields or columns.

-query => undef || SQL WHERE clause

-filter => undef || filter sub{}(self, {fieldName => fieldValue,...}) -> allow

-order => [fieldName||fieldId => 1||2,... colName||colNumber => 'asc'||'desc',...] || 'SQL ORDER BY clause'

-undefs => undef || 1 || 0 - include undefined values to records returned

"ARS form name", "ARS field name", "ARS form name"."ARS field name" may be used
in '-fields' and '-query'.


=item dbierrstr () -> dbi->errstr

(C<Error Processing and Echo>)
Last L<DBI|DBI> error, <dbi>->errstr

lib/ARSObject.pod  view on Meta::CPAN 

Parameters:

-form | -into | -schema => schema or form name

-id=>entryId

-echo=>1 # output command to STDOUT



=item entryDif ({old field => value,...}, {new field => value,...}, ?exclude empty) -> {values to update} | undef

(C<ARS methods>)
Distinguish the difference between two hashes of field => value.
Returns undef when no difference.



=item entryIns (-form=>form, ?-echo=>1, field => value,...) -> id | self

(C<ARS methods>)
Insert new record into ARS using ARS::ars_CreateEntry().
Field names are translated to ids using C<-metadn>/C<-meta>.
Field values are translated with C<strIn> when C<-strFields>.

lib/ARSObject.pod  view on Meta::CPAN 


Values in the query condition should be converted to ARS representation explicitly:
strings should be quoted with C<arsquot>(), dates - converted with C<timestr>().

Field names or ids in the query condition should be enclosed in ' single quotes.

Parameters:

-form | -from | -schema => schema or form name

-fields =>undef
# if '-fields' parameter omited, list of record IDs will be returned as a result set.

-fields => [{fieldId=>1, columnWidth=>number, separator=>"\t"} | {fieldName=>name, width=>number} | {field=>name|id, width=>number},...]
# result set is strings up to 128 bytes, ARS::ars_GetListEntry() used.

-fields => [fieldId | fieldName,...]
# result set is hash refs for each record, ARS::ars_GetListEntryWithFields() used.

-fields => '*' | '*-$' | 1, -xfields=>sub{}(self, field) || [fieldName| fieldId,...]
# result set is hash refs for each record, ARS::ars_GetListEntryWithFields() used.

lib/ARSObject.pod  view on Meta::CPAN 

-for ||-foreach => sub(self, form, id|string, ?{record}){die "last\n", die "next\n"} -> self
# iterator sub{} for each row

-echo => 1
# output query and details to STDOUT



=item schema () -> {schemaName => {metadata},...}

=item schema (schema name) -> {schema metadata} || undef

=item schfld (schema) -> {fieldName=>{field metadata},...}

=item schfld (schema, field name | meta) -> {field metadata} || undef

=item schid (schema, field '-metaid' | id) -> {fieldName=>'name', FieldId=>id}

=item schdn (schema, field '-metadn' | name) -> {fieldName=>'name', FieldId=>id}

=item schvals (schema, field name | id | meta) -> [itemNumber,...] || undef

=item schlbls (schema, field name | id | meta) -> {itemNumber => itemName,...} || undef

=item schlblsl (schema, field name | id | meta) -> {itemNumber => localised itemName,...} || undef

(C<Metadata>)
Access to ARS metadata loaded by C<connect>, C<arsmeta>, C<arsmetamin>.

 

=item set (param => value,...) -> self

=item set (param) -> value

lib/ARSObject.pod  view on Meta::CPAN 

Distinct values from C<vfdata>,
alike [sort keys %{C<vfhash>(-slotName, keyName)}].
Each element of C<vfdata>(-slotName) should be a hash with 'keyName' element.



=item vfhash (-slotName, keyName) -> {keyName=>{key => value},...}

=item vfhash (-slotName, keyName, keyValue) -> {key => value}

=item vfhash (-slotName, keyName, keyValue, key) -> value || undef if !ref(keyValue)

=item vfhash (-slotName, keyName, filter sub{}(self, -slot, keyName, keyValue, $_=elem)) -> {keyName=>{key => value},...}

(C<Variable files>)
Direct access to C<vfdata> using key name and value.
Each element of C<vfdata>(-slotName) array should be a hash with 'keyName' element.
C<vfdata> array will be automatically cached into hash "-slotName/keyName".



( run in 1.994 second using v1.01-cache-2.11-cpan-d80b1682f3f )