ARSObject
2 results

 view release on metacpan or  search on metacpan

lib/ARSObject.pm  view on Meta::CPAN 

use UNIVERSAL;
use strict;
use POSIX qw(:fcntl_h);

$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

lib/ARSObject.pm  view on Meta::CPAN 

	#,-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) =@_;
 foreach my $k (keys %a) {
	$s->{$k} =$a{$k}
 }
 if ($a{-die}) {

lib/ARSObject.pm  view on Meta::CPAN 

 elsif ($a{-vfbase}) {
	if ($a{-vfbase} !~/[\\\/]/) {
		my $v =$^O eq 'MSWin32' ? scalar(Win32::GetFullPathName($0)) : $0;
		$s->{-vfbase} =$v =~/^(.+?[\\\/])[^\\\/]+$/ ? $1 .$a{-vfbase} : $a{-vfbase};
	}
 }
 $s
}


sub ineval {	# is inside eval{}?
		# for PerlEx and mod_perl
		# see CGI::Carp::ineval comments and errors
 return $^S	if !($ENV{GATEWAY_INTERFACE}
			&& ($ENV{GATEWAY_INTERFACE} =~/PerlEx/))
		&& !$ENV{MOD_PERL};
 my ($i, @a) =(1);
 while (@a =caller($i)) {
	return(0) if $a[0] =~/^(?:PerlEx::|Apache::Perl|Apache::Registry|Apache::ROOT)/i;
	return(1) if $a[3] eq '(eval)';
	$i +=1;
 }
 $^S
}

		# error message form ??? use ???
		# (err/var, command, operation, function, args)
sub efmt {
	efmt1(@_)
}

sub efmt0 {
 my ($s, $e, $c, $o, $f, @a) =@_;
 cpcon($s
	,join(': '
		,($c ? $c : ())
		,($f ? $f .'(' .join(',', map {$s->dsquot($_)} @a) .')' : ())
		,($o ? $o : ())
		)
	.($e && ($e eq '$!') && $^E ? (' -> ' .$! .' / ' .$^E) : ( ' -> ' .($e || 'unknown error')))
	)
}

sub efmt1 {
 my ($s, $e, $c, $o, $f, @a) =@_;
 cpcon($s
	,join(' # '
		,($e && ($e eq '$!') && $^E ? ($! .' / ' .$^E) : ($e || 'unknown error'))
		,($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;
 $v =~/^\d+$/ ? $v : ('"' .$v .'"');
}


sub dsquot {	# Quote data structure
   $#_ <2		# (self, ?'=>', data struct)
 ? dsquot($_[0],'=> ',$_[1])
 : !ref($_[2])	# (, hash delim, value) -> stringified
 ? strquot($_[0],$_[2])
 : ref($_[2]) eq 'ARRAY'
 ? '[' .join(', ', map {dsquot(@_[0..1],$_)
			} @{$_[2]}) .']'
 : ref($_[2]) eq 'HASH'
 ? '{' .join(', ', map {$_ .$_[1] .dsquot(@_[0..1],$_[2]->{$_})
			} sort keys %{$_[2]}) .'}'
 : strquot($_[0],$_[2])
}


sub dsquot1 {	# Quote data structure, defined elements only
   $#_ <2		# (self, ?'=>', data struct)
 ? dsquot1($_[0],'=> ',$_[1])
 : !ref($_[2])	# (, hash delim, value) -> stringified
 ? strquot($_[0],$_[2])
 : ref($_[2]) eq 'ARRAY'
 ? '[' .join(', ', map {defined($_) ? dsquot1(@_[0..1],$_) : ()
			} @{$_[2]}) .']'
 : ref($_[2]) eq 'HASH'
 ? '{' .join(', ', map {defined($_[2]->{$_}) ? $_ .$_[1] .dsquot1(@_[0..1],$_[2]->{$_}) : ()
			} sort keys %{$_[2]}) .'}'
 : strquot($_[0],$_[2])
}


sub dsdump {     # Data structure dump to string
 my ($s, $d) =@_;	# (data structure) -> dump string
 eval('use Data::Dumper');
 my $o =Data::Dumper->new([$d]); 
 $o->Indent(1);
 $o->Deepcopy(1);
 $o->Dump();
}


sub dsparse {  # Data structure dump string to perl structure
 my ($s, $d) =@_;	# (string) -> data structure
 eval('use Safe; 1')
 && Safe->new()->reval($d)
}


sub dscmp {	# Compare data structures
 my($s, $ds1, $ds2) =@_;
 return(1) if (defined($ds1) && !defined($ds2)) ||(defined($ds2) && !defined($ds1));
 return(0) if !defined($ds1) && !defined($ds2);
 return(1) if (ref($ds1) ||'') ne (ref($ds2) ||'');
 return($ds1 cmp $ds2) if !ref($ds1);
 return(dsquot($s,$ds1) cmp dsquot($s,$ds2)) if ref($ds1) eq 'ARRAY';
 return(dsquot($s,$ds1) cmp dsquot($s,$ds2)) if ref($ds1) eq 'HASH';
 $ds1 cmp $ds2
}


sub dsunique {	# Unique list
 my %h =(map {defined($_) ? ($_ => 1) : ()} @_[1..$#_]);
 use locale;
 sort keys %h
}



sub dsmerge {	# Merge arrays or hashes
 my $r;
 if (ref($_[1]) eq 'ARRAY') {
	$r =[];
	for (my $i=1; $i <=$#_; $i++) {
		for (my $j=0; $j <=$#{$_[$i]}; $j++) {
			$r->[$j] =$_[$i]->[$j]
		}
	}
 }
 elsif (ref($_[1]) eq 'HASH') {

lib/ARSObject.pm  view on Meta::CPAN 

	for (my $i=1; $i <=$#_; $i++) {
		foreach my $k (keys %{$_[$i]}) {
			$r->{$k} =$_[$i]->{$k}
		}
	}
 }
 $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/;

lib/ARSObject.pm  view on Meta::CPAN 

 $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 =$';

lib/ARSObject.pm  view on Meta::CPAN 

    $th{$m}=$d;
 }
#eval('use POSIX');
 my $r =POSIX::mktime($th{'s'}||0,$th{'M'}||0,$th{'h'}||0,$th{'d'}||0,($th{'m'}||1)-1,$th{'y'}||0,0,0,(localtime(time))[8]);
# &{$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 {
 $_[0]->{-charset} && ($_[0]->{-charset} =~/^\d/)
	? 'windows-' .$_[0]->{-charset}
	: ($_[0]->{-charset} || ($_[0]->{-cgi} && $_[0]->{-cgi}->charset())
		|| eval('!${^ENCODING}') && eval('use POSIX; POSIX::setlocale(POSIX::LC_CTYPE)=~/\\.([^.]+)$/ ? "cp$1" : "cp1252"'))
}


sub cptran {	# Translate strings between codepages
 my ($s,$f,$t,@s) =@_;	# (from, to, string,...) -> string,...
 if (($] >=5.008) && eval("use Encode; 1")) {
	map {$_=  /oem|866/i	? 'cp866'
		: /ansi|1251/i	? 'cp1251'
		: /koi/i	? 'koi8-r'
		: /8859-5/i	? 'iso-8859-5'
		: $_
		} $f, $t;
	map {Encode::is_utf8($_)
		? ($_ =Encode::encode($t, $_, 0))

lib/ARSObject.pm  view on Meta::CPAN 

		elsif ($v =~/ansi|1251/i) {$v ='ÀÁÂÃÄŨÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÜÛÚÝÞßàáâãäå¸æçèéêëìíîïðñòóôõö÷øùüûúýþÿ'}
		elsif ($v =~/koi/i)       {$v ='áâ÷çäå³öúéêëìíîïðòóôõæèãþûýøùÿüàñÁÂ×ÇÄÅ£ÖÚÉÊËÌÍÎÏÐÒÓÔÕÆÈÃÞÛÝØÙßÜÀÑ'}
		elsif ($v =~/8859-5/i)    {$v ='°±²³´µ¡¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÌËÊÍÎÏÐÑÒÓÔÕñÖ×ØÙÚÛÜÝÞßàáâãäåæçèéìëêíîï'}
	}
	map {eval("~tr/$f/$t/") if defined($_)} @s;
 }
 @s >1 ? @s : $s[0];
}


sub cpcon {		# Translate to console codepage
   $_[0] && $_[0]->{-cpcon}
 ? &{$_[0]->{-cpcon}}(@_)
 : $#_ <2
 ? $_[1]
 : (@_[1..$#_])
}


sub sfpath {		# self file path
			# () -> script's dir
			# (subpath) -> dir/subpath
 my $p =$0 =~/[\\\/]/ ? $0 : $^O eq 'MSWin32' ? Win32::GetFullPathName($0) : '';
 $_[1]
 ? (($p =~/^(.+?[\\\/])[^\\\/]+$/ ? $1 : '') .$_[1])
 : ($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)
	}

lib/ARSObject.pm  view on Meta::CPAN 

 else {
	while (defined($r =readdir(FILE))) {
		push @r, $r if !$cf ||&$cf($s,$f,$_ =$r)
	}
	closedir(FILE);
	return @r;
 }
}


sub fstore {		# Store file
 my $s =shift;		# ('-b',filename, strings) -> success
 my $o =$_[0] =~/^-(?:\w[\w\d+-]*)*$/ ? shift : '-';
 my $f =$_[0]; $f ='>' .$f if $f !~/^[<>]/;
 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++) {

lib/ARSObject.pm  view on Meta::CPAN 

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

lib/ARSObject.pm  view on Meta::CPAN 

 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')))
}


sub vfstore {		# Store variables file
			# (varname, {data}) -> success
			# (-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;

lib/ARSObject.pm  view on Meta::CPAN 

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

lib/ARSObject.pm  view on Meta::CPAN 

		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
 my($s,$f,$nn) =@_;	# (-slot, ?period seconds) -> vfload
 return(1) if $f !~/^-/;
 vfload($s,$f,1,$nn ||1);
}



sub vfclear {	# Clear vfdata() and vfhash()
 my($s,$f) =@_;	# (-slot, ?period seconds) -> vfload
 return(1) if $f !~/^-/;
 delete($s->{$f});
 foreach my $k (keys %$s) {
	next if $k !~/^\Q$f\E[\/].+/;
	delete $s->{$k};
 }
 1;
}


sub vfdata {	# Access to array data from variables file
		# automatically load using vfload().
		# (-slot) -> [array]
		# (-slot, filter sub{}(self, -slot, index, $_=value)) -> [array]
 vfload($_[0], $_[1], 1) if !$_[0]->{$_[1]} || (ref($_[0]->{$_[1]}) eq 'CODE');
 if ($_[2]) {
	if (ref($_[2]) eq 'CODE') {
		local $_;
		local $_[0]->{-cmd} =($_[0]->{-cmd} ? $_[0]->{-cmd} .': ' : '')
			."vfdata('$_[1]', sub{})";
		my ($rr, $v);

lib/ARSObject.pm  view on Meta::CPAN 

		return($rr)
	}
	else {
		return($_[0]->{$_[1]}->[$_[2]])
	}
 }
 $_[0]->{$_[1]}
}


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}) {

lib/ARSObject.pm  view on Meta::CPAN 

 ? $s->{$kk}
 : !ref($s->{$kk}->{$v})
 ? $s->{$kk}->{$v}
 : defined($e)
 ? $s->{$kk}->{$v}->{$e}
 : $s->{$kk}->{$v}
}



sub vfdistinct {# Distinct values from vfdata() field.
		# (-slot, key name) -> [keys %{vfhash(...)}]
		# (-slot, key name => filter sub{}(self, -slot, key, $_ = value)) -> [keys %{vfhash(...)}]
 my($s, $f, $k, $v) =@_;
 my(%rh, $t);
 local $_;
 local $_[0]->{-cmd} =($_[0]->{-cmd} ? $_[0]->{-cmd} .': ' : '')
	."vfdistinct('$f', '$k', sub{})";
 $s->vfload($f, 1) if !$s->{$f} ||(ref($s->{$f}) eq 'CODE');
 if (ref($s->{$f}) eq 'ARRAY') {
	for(my $i=0; $i<=$#{$s->{$f}}; $i++) {

lib/ARSObject.pm  view on Meta::CPAN 

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

lib/ARSObject.pm  view on Meta::CPAN 

	# print $s->cpcon($s->dsdump($s->{-meta})), "\n"; exit(0);
 }
 else {
	$s->{-meta} ={};
	return(&{$s->{-die}}($s->efmt('No metadata',$s->{-cmd})))
 }
 $s->arsmetaix() if $s->{-meta};
}


sub arsmetaix {	# Index ARS metadata
 my $s =shift;
 if ($s->{-meta}) {
	foreach my $f (keys %{$s->{-meta}}){
		next if $f =~/^-/;
		$s->{-meta}->{$f}->{-fldids} ={}
			if !$s->{-meta}->{$f}->{-fldids};
		foreach my $ff (keys %{$s->{-meta}->{$f}->{-fields}}) {
			$s->{-meta}->{$f}->{-fldids}->{$s->{-meta}->{$f}->{-fields}->{$ff}->{fieldId}}
				=$s->{-meta}->{$f}->{-fields}->{$ff}
		}

lib/ARSObject.pm  view on Meta::CPAN 

			$s->{-metadn}->{$s->{-metaid}->{$id}->{fieldName}} =$s->{-metaid}->{$id}
				if $s->{-metaid}->{$id}->{fieldName}
				&& !$s->{-metadn}->{$s->{-metaid}->{$id}->{fieldName}};
		}
	}
	# print $s->cpcon($s->dsdump($s->{-metaid})), "\n"; exit(0);
 }
}


sub arsmetamin {	# Minimal ARS metadata ('-meta-min' varfile)
 my $s =shift;		# 	refresh after 'arsmeta'/'connect'
 $s->set(@_);		# 	load instead of 'arsmeta'/'connect'
 local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
	.($s->{-schgen} ? "dumper('" .$s->vfname('meta-min') ."')" : 'arsmetamin()');
 if (ref($s->{-schgen})
 || !$s->{-schgen}
 || ($s->{-schgen} && ($s->{-schgen} >1))
 || (!-e $s->vfname('-meta-min'))
	) {
	$s->arsmeta() if !$s->{-meta} ||!scalar(%{$s->{-meta}});

lib/ARSObject.pm  view on Meta::CPAN 

				=values %{$fs->{-fields}->{$ff}}};
		}
	}
	$s->arsmetaix()
 }
 delete $s->{'-meta-min'};
 $s;
}


sub arsmetasql {	# SQL ARS metadata ('-meta-sql' varfile)
 my $s =shift;		# 	refresh after 'arsmeta'/'connect'
 $s->set(@_);		# !!! 'enum' texts
 local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
	.($s->{-schgen} ? "dumper('" .$s->vfname('meta-sql') ."')" : 'arsmetasql()');
 if (ref($s->{-schgen})
 || !$s->{-schgen}
 || ($s->{-schgen} && ($s->{-schgen} >1))
 || (!-e $s->vfname('-meta-sql'))
	) {
	$s->arsmeta() if !$s->{-meta} ||!scalar(%{$s->{-meta}});

lib/ARSObject.pm  view on Meta::CPAN 

		$s->vfstore('-meta-sql') if $s->{-schgen} && ($s->{-schgen} eq '1' ? !-e $s->vfname('-meta-sql') : 1);
	};
 };
# print do($s->vfname('-meta-sql'))||0,' ', $@||'', $s->vfname('-meta-sql'),' ', "\n";
 $s->vfload('-meta-sql') if !$s->{'-meta-sql'} && $s->{-schgen};
 $s;
}



sub sqlnesc {	# SQL name escaping, default for '-sqlname', '-sqlntbl', '-sqlncol'
 my $v =lc($_[1]); # (self, name) -> escaped
 $v =~s/[^a-zA-Z0-9_]/_/g;
 $v =substr($v,0,64) if length($v) >64;
 $v
}


sub sqlninc {	# SQL name incrementing, default for '-sqlninc'
 my $v =$_[1];	# (self, name) -> incremented
 my ($n, $nn);
 if (0) {
	($n, $nn) =$v =~/^(.+?)_([1-9]+)$/ ? ($1, '_' .($2 +1)) : ($v, '_1');
 }
 else {
	($n, $nn) =$v =~/^(.+?)_([A-Z]+)$/ ? ($1, $2) : ($v, '');
	$nn ='_' .(!$nn ? 'A' : substr($nn,-1,1) eq 'Z' ? $nn .'A' : (substr($nn,0,-1) .chr(ord(substr($nn,-1,1)) +1)));
 }
 $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};

lib/ARSObject.pm  view on Meta::CPAN 

		};
	$s->{'-meta-sql'}->{$tn}->{-cols}->{$tc} =$tch;
	$s->{'-meta-sql'}->{$tn}->{-fields}->{$ff} =$tc;
	$s->{'-meta-sql'}->{$tn}->{-ids}->{$ffh->{fieldId}} =$tc
		if $ffh->{fieldId};
 }
 $tc
}


sub ars_errstr {# Last ARS error
	$ARS::ars_errstr
}



sub schema {	# Schema by form name
		# (schema) -> {schema descr}
		# () -> {schemaName=>{descr}}
 $_[1]
 ? $_[0]->{-meta}->{ref($_[1]) ? $_[1]->{schemaName} : $_[1]}
 : $_[0]->{-meta};
}


sub schfld {	# Schema of field
		# (schema, field) -> {field descr}
		# ({schemaName=>name, fieldName=>name}) -> {field descr}
		# (schema) -> {field=>descr}
 ref($_[1])
 ? $_[0]->{-meta}->{$_[1]->{schemaName}}->{-fields}->{$_[1]->{fieldName}}
 : $_[2]
 ? $_[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'}

lib/ARSObject.pm  view on Meta::CPAN 

	}
	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'}

lib/ARSObject.pm  view on Meta::CPAN 

	}
	elsif ((ref($et->[0]) eq 'HASH') && defined($et->[0]->{itemNumber})) {
		$ff->{-listVals} =[map {$et->[$_]->{itemNumber}} (0..$#$et)]
	}
 }
 $ff && $ff->{-listVals}
}



sub strOut {	# Convert field value for output, using '-meta'
		# (schema, fieldId, fieldValue) -> fieldValue
 my($s,$f,$ff,$v) =@_;
 $ff =ref($ff) ? $ff : $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff} : $s->{-meta}->{$f}->{-fields}->{$ff}; 
 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})) {

lib/ARSObject.pm  view on Meta::CPAN 

	schlbls(@_);
	$v =strOut(@_) if $ff->{-hashOut};
 }
 elsif ($ff->{dataType} eq 'time') {
	$v =strtime($s,$v)
 }
 $v
}


sub strIn {	# Convert input field value to internal, using '-meta'
		# (schema, fieldId, fieldValue) -> fieldValue
 my($s,$f,$ff,$v) =@_;
 $ff =ref($ff) ? $ff : $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff} : $s->{-meta}->{$f}->{-fields}->{$ff};
 if (!defined($v) ||!$ff ||!$s->{-strFields}) {
 }
 elsif ($v =~/^\d+$/) {
 }
 elsif ($ff->{fieldLbvl} && ($ff->{fieldLbvl} =~/\\(\d+)\\\Q$v\E(?:\\|$)/)) {
	# && ($s->{-strFields} ==2)
	$v =$1

lib/ARSObject.pm  view on Meta::CPAN 

	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'
		# (additional field options)
 my ($s, @a) =@_;
 @a =('fieldLblc') if !@a;
 unshift @a, 'fieldName', 'fieldId', 'dataType', 'option', 'createMode';
 map {	my $f =$_;
	$f =~/^-/
	? ()
	: map {	my $ff =$s->{-meta}->{$f}->{-fields}->{$_};
		join("\t", $f
			#, $ff->{option} && ($ff->{option} == 4) ? 'ro' : ()

lib/ARSObject.pm  view on Meta::CPAN 

				? ''
				: $_ 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'

lib/ARSObject.pm  view on Meta::CPAN 

		}
		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 '');
 my $r ='';
 if (!$c) {
	while ($q =~/^(.*?)(['"]|#[\w]+[\w\d]+\()(.*)/) {
		$r .=$1;
		$q  =$3;
		if (!defined($q)) {
			$q =''

lib/ARSObject.pm  view on Meta::CPAN 

	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,...)

lib/ARSObject.pm  view on Meta::CPAN 

		}
	}
	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) {

lib/ARSObject.pm  view on Meta::CPAN 

			: strOut($s,$f,$id,$v);
	}
	else {
		$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{$_})

lib/ARSObject.pm  view on Meta::CPAN 

		$a{'Incident Number'} =$s->entryIns(-form=>'HPD:CFG Ticket Num Generator', 'DataTags'=>'za')
	}
	elsif (defined($a{'Incident Number'}) && !$a{'Incident Number'}) {
		delete $a{'Incident Number'}
	}
 }
 \%a
}


sub entryIns {	# ars_CreateEntry
		# (-form=>form, field=>value) -> id
		# ?-echo=>1
		# ?'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 $_;

lib/ARSObject.pm  view on Meta::CPAN 

 }
 if (!$r) {
	my $t =$s->efmt($ARS::ars_errstr,$s->{-cmd});
	return(&{$s->{-die}}($t))	if !$r &&  $ARS::ars_errstr;
	# warn($t)			if !$r && !$ARS::ars_errstr;
 }
 $r ||$s
}


sub entryUpd {	# ars_SetEntry(ctrl,schema,entry_id,getTime,...)
		# (-form=>form, -id=>entryId, field=>value) -> id
		# ?-echo=>1
 #
 # ??? ARMergeEntry()/ars_MergeEntry(ctrl, schema, mergeType, ...)
 # ??? ars_EncodeDiary(diaryEntryHash1, ... diaryEntryHashN)
 #
 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-into};
 my $id=$a{-id};
 print $s->cpcon("entryUpd(-form=>'$f',-id=>'$id')\n")

lib/ARSObject.pm  view on Meta::CPAN 

		}
		($k => $v)
		} keys %a;
 my $r =ARS::ars_SetEntry($s->{-ctrl}, $f, $id, 0, %a);
 return(&{$s->{-die}}($s->efmt($ARS::ars_errstr, $s->{-cmd})))
	if !$r && $ARS::ars_errstr;
 $id
}


sub entryDel {	# ars_DeleteEntry
		# (-form=>form, -id=>entryId) -> id
		# ?-echo=>1
 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-from} ||$a{-into};
 my $id=$a{-id};
 print $s->cpcon("entryDel(-form=>'$f',-id=>'$id')\n")
	if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
 delete @a{qw(-schema -form -from -into -id -echo)};
 my $r =ARS::ars_DeleteEntry($s->{-ctrl}, $f, $id);
 return(&{$s->{-die}}($s->efmt($ARS::ars_errstr
		,"entryDel(-form=>'$f',-id=>'$id')")))
	 if !$r && $ARS::ars_errstr;
 $id
}


sub entryBLOB {	# BLOB field retrieve/update
		# (-form=>form, -id=>entryId, -field=>fieldId|fieldName
		# ,?-set=>data
		# ,?-file=>filePath, ?-set=>boolean
 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-from} ||$a{-into};
 my $eu =!$a{-file} ? exists($a{-set}) : exists($a{-set}) ? $a{-set} : $a{-into};
 if ($eu) {
	return($s->entryUpd(-form=>$f, -id=>$a{-id}
		, exists($a{-echo}) ? (-echo=>$a{-echo}) : ()
		, $a{-field}

lib/ARSObject.pm  view on Meta::CPAN 

		,$a{-field} =~/^\d+$/ ? $a{-field} : schdn($s,$f,$a{-field})->{fieldId}
		,$a{-file} ? (ARS::AR_LOC_FILENAME(), $a{-file}) : (ARS::AR_LOC_BUFFER()));
	return(&{$s->{-die}}($s->efmt($ARS::ars_errstr
		,"entryBLOB(-form=>'$f',-id=>'" .$a{-id} ."',-field=>" .$a{-field} ."')")))
		if !defined($r) && $ARS::ars_errstr;
	return(!$a{-file} ? $r : $r ? $a{-id} : $r)
 }
}


sub dbi {	# DBI connection object
 return($_[0]->{-dbi}) if $_[0]->{-dbi};
 dbiconnect(@_)
}


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) =@_;
 my @t =$s->dbi()->tables('',$sch||$s->{-sqlschema}||'', $tbl||'%');
 if (!scalar(@t) 
 && (((ref($s->{-dbiconnect}) ? $s->{-dbiconnect}->[0] : $s->{-dbiconnect})||'') =~/^dbi:ADO:/i)) {
	$sch =$sch||$s->{-sqlschema};
	@t =$sch
		? (map {$_ =~/\."*\Q$sch\E"*\./i ? ($_) : ()} $s->dbi()->tables())
		: $s->dbi()->tables();
 }
 @t
}


sub dbicols {	# DBI table columns
 my ($s, $sch, $tbl) =@_;
 # my $st =$s->dbiquery('SHOW COLUMNS FROM ' .($sch ? $sch .'.' : '') .$tbl);
 my $st =$s->dbi()->column_info('',$sch||$s->{-sqlschema}||'', $tbl||'','%');
 @{$st->fetchall_arrayref({})}
}


sub dbitypespc { # DBI column type spec
 my ($s, $d) =@_;
 ($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;

lib/ARSObject.pm  view on Meta::CPAN 

	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

lib/ARSObject.pm  view on Meta::CPAN 

		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'

lib/ARSObject.pm  view on Meta::CPAN 

			? ($_ => $r->{$_})
			: ()
		} keys %$r};
	next if $arg{-filter} && !&{$arg{-filter}}($s,$r1);
	push @r, $r1;
 }
 @r
}


sub dbidsqq {	# DBI datastore - quote/parse condition to SQL names
 my ($s,$sf,$mh) =@_;	# (self, query string, default sql metadata)
 if (0) {
	my $q =substr($s->{-dbi}->quote_identifier(' '),0,1);
	$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 : "''";

lib/ARSObject.pm  view on Meta::CPAN 

				last
			}
		}
	}
 }
 $sr .$sf
}



sub cgi {	# CGI object
 return($_[0]->{-cgi}) if $_[0]->{-cgi};
 cgiconnect(@_)
}


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

lib/ARSObject.pm  view on Meta::CPAN 

		#	$s->{-cgi}->param($1, $s->{-cgi}->param("$1__L_"));
		#	$s->{-cgi}->param("$1__C_", 1);
			$s->{-cgi}->delete("$1__L_");
		}
	}
 }
 $s->{-cgi}
}


sub cgipar {	# CGI parameter
 $_[0]->{-cgi}->param(@_[1..$#_])
}


sub cgiurl {	# CGI script URL
 local $^W =0;	# $ENV{PATH_INFO}
 if ($#_ >0) {
	my $v =($_[0]->{-cgi}||$_[0]->cgi)->url(@_[1..$#_]);
	if ($v) {}
	elsif (!($ENV{PERLXS} ||(($ENV{GATEWAY_INTERFACE}||'') =~/PerlEx/))) {}
	elsif (($#_ >2) ||(($#_ ==2) && !$_[2])) {}
	elsif ($_[1] eq '-relative') {
		$v =$ENV{SCRIPT_NAME};
		$v =$1 if $v =~/[\\\/]([^\\\/]+)$/;
	}

lib/ARSObject.pm  view on Meta::CPAN 

	if ($ENV{PERLXS} ||(($ENV{GATEWAY_INTERFACE}||'') =~/PerlEx/)) {
		$v .= (($v =~/\/$/) ||($ENV{SCRIPT_NAME} =~/^\//) ? '' : '/')
			.$ENV{SCRIPT_NAME}
			if ($v !~/\w\/\w/) && $ENV{SCRIPT_NAME};
	}
	return($v)
 }
}


sub cgitext {	# CGI textarea field
 $_[0]->{-cgi}->textarea(@_[1..$#_])
	# -default=>$v, -override=>1
}


sub cgistring {	# CGI string field
 $_[0]->{-cgi}->textfield(@_[1..$#_])
}


sub cgiselect {	# CGI selection field composition
		# -onchange=>1 reloads form
 my ($s, %a) =@_;
 my $cs =$a{-onchange} && (length($a{-onchange}) ==1);
 ($cs
 ? '<input type="hidden" name="' .$a{-name} .'__C_" value="" />'
 : '')
 .$s->{-cgi}->popup_menu(%a
	, $a{-labels} && !$a{-values}
	? (-values => do{use locale; [sort {$a{-labels}->{$a} cmp $a{-labels}->{$b}} keys %{$a{-labels}}]})
	: ()
	, $cs
	? (-onchange => '{window.document.forms[0].' .$a{-name} .'__C_.value="1"; window.document.forms[0].submit(); return(false)}')
	: ()
	)
 .( $cs && ($a{-onchange}=~/^\d/) && $s->{-cgi}->param($a{-name} .'__C_')
  ? '<script for="window" event="onload">window.document.forms[0].' .$a{-name} .'.focus()</script>'
  : '')
}


sub cgiddlb {	# CGI drop-down listbox field composition
		# -strict=> - disable text edit, be alike cgiselect
 my ($s, %a) =@_;
 $s->cgi();
 my $n =$a{-name};
 my $nl="${n}__L_";
 my $av=sub{	return($a{-values}) if $a{-values};
		use locale;
		$a{-values} =[
			  $a{-labels0}
			? sort {(defined($a{-labels0}->{$a}) ? $a{-labels0}->{$a} : '')

lib/ARSObject.pm  view on Meta::CPAN 

		)
	: ("<input type=\"submit\" name=\"${n}__O_\" value=\"...\" title=\"open\"$ac$as />"
	 .($s->{-cgi}->param("${n}__C_") ||$s->{-cgi}->param("${n}__X_")
		? "<script for=\"window\" event=\"onload\">{window.document.forms[0].${n}__O_.focus()}</script>"
		: ''
		))
	)
}


sub cgiesc {	# escape strings to html
	$_[0]->{-cgi}->escapeHTML(@_[1..$#_])
}


sub cgitfrm {	# table form layot
		# -form =>{form attrs}, -table=>{table attrs}, -tr=>{tr attrs}, -td=>{}, -th=>{}
 my ($s, %a) =$_[0];
 my $i =1;
 while (ref($_[$i]) ne 'ARRAY') {$a{$_[$i]} =$_[$i+1]; $i +=2};
 $s->cgi->start_form(-method=>'POST',-action=>'', $a{-form} ? %{$a{-form}} : ())
	# ,-name=>'test'
 .$s->{-cgi}->table($a{-table} ? $a{-table} : (), "\n"
 .join(''
	, map {	my $r =$_;
		$s->{-cgi}->Tr($a{-tr} ? $a{-tr} : (), "\n"

lib/ARSObject.pm  view on Meta::CPAN 

				? $s->{-cgi}->td($a{-td} || {-align=>'left', -valign=>'top'}, $_)
				: $s->{-cgi}->th($a{-th} || $a{-td} || {-align=>'left', -valign=>'top'}, $_)
				) ."\n"
				} @$r)
		) ."\n"
		} @_[$i..$#_])) ."\n"
 .$s->cgi->end_form()
}


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}
}


sub smtp {	# SMTP connection object
 return($_[0]->{-smtp}) if $_[0]->{-smtp};
 smtpconnect(@_)
}


sub smtpsend {	# SMTP mail msg send
		# -from||-sender, -to||-recipient, 
		# -data|| -subject + (-text || -html)
 my ($s, %a) =@_;
 return(&{$s->{-die}}("SMTP host not defined"))
	 if !$s->{-smtphost};
 local $s->{-smtpdomain} =$s->{-smtpdomain} 
			|| ($s->{-smtphost} && $s->smtp(sub{$_[1]->domain()}))
			|| 'nothing.net';
 $a{-from}	=$a{-from} ||$a{-sender} ||$ENV{REMOTE_USER} ||$ENV{USERNAME};
 $a{-from}	=&{$a{-from}}($s,\%a)	if ref($a{-from}) eq 'CODE';

lib/ARSObject.pm  view on Meta::CPAN 

	|| 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:

lib/ARSObject.pm  view on Meta::CPAN 

		print("Error $!\n");
		$s->fstore(">>$lf", $s->strtime() ."\t$$\t$!\n")
			if $lf;
	}
 }
 $r
}



sub _sooncl {	# soon() command line former
 my ($s, $cs, $q) =@_;
 my $nc;
 my $qry =$cs;
 if (ref($cs)) {
	return(&{$s->{-die}}("MSWin32 required for `at` in soon()\n"))
		if $^O ne 'MSWin32';
	$cs->[0] =Win32::GetFullPathName($cs->[0])
		if ($^O eq 'MSWin32') && ($cs->[0] !~/[\\\/]/);
	$cs->[0] = $cs->[0]=~/^(.+?)[^\\\/]+$/ ? $1 .'perl.exe' : $cs->[0]
		if $cs->[0] =~/\.dll$/i;

lib/ARSObject.pm  view on Meta::CPAN 

				? (do{$nc =$_->[0]})
				: $_
				} @$cs)
		: join(' ', map {!defined($_) ? '""' : ref($_) ? join('', @$_) : $_
				} @$cs);
 }
 $qry
}


sub _sooncln {	# soon() cleaner
 my ($s, $mm, $lf, $cr, $cs, $strt) =@_;
 $lf =$s->vfname($lf) if $lf && ($lf !~/[\\\/]/);
 if (ref($cs) ? scalar(@$cs) : $cs) {
	my $nc;
	my $qry =_sooncl($s, $cs, 1);
	print "Starting '$qry'...\n" if $strt && defined($mm);
	$s->fstore(">>$lf", "\n" .$s->strtime() ."\t$$\tStarting '$qry'...\n")
		if $strt && $lf && defined($mm);
	sleep(int(rand(20))) if $strt && defined($mm) && $cr;
	foreach my $l (`at`) {

lib/ARSObject.pm  view on Meta::CPAN 

		print("$cmd # $l\n");
		$s->fstore(">>$lf", $s->strtime() ."\t$$\t$cmd # $l\n")
			if $lf;
		system($cmd);
	}
 }
 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}) {

lib/ARSObject.pm  view on Meta::CPAN 

		push @bl, {%$f, -action=>1};
		delete $bl[$#bl]->{-widget};
		delete $ah->{$f->{-namecgi}};
	}
	push @{$s->{-fpl}}, @bl;
 }
 $s
}


sub cfpused {	# Field Player: field should be used?
		# (self, field) -> yes?
 my ($s, $f) =@_;
 return(map {ref($_) && cfpused($s, $_) ? $_ : ()} @{$s->{-fpl}})
	if !$f;
 $f =$s->{-fphc}->{$f} ||$s->{-fphd}->{$f}
	if !ref($f);
 !ref($f) || (ref($f) ne 'HASH')
 ? 0
 : (	!exists($f->{-used})
	? 1

lib/ARSObject.pm  view on Meta::CPAN 

	? scalar(grep {my $v =cfpused($s, $_) && cfpvv($s, $_);
			!defined($v) || ($v eq '')} @{$f->{-unused}})
	: !ref($f->{-unused}) && ($f->{-unused} !~/^\d/)
	? !(do{	my $v =cfpused($s, $f->{-unused}) && cfpvv($s, $f->{-unused});
		defined($v) && ($v ne '')})
	: ($f->{-unused} && 1)
	)
}


sub cfpn {	# Field Player: field name
		# (self, field || fieldname) -> cgi field name
 ref($_[1])
 ? $_[1]->{-namecgi}
 : (($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]} ||{})->{-namecgi} ||$_[1])
}


sub cfpnd {	# Field Player: field name
		# (self, field || fieldname) -> db field name
 ref($_[1])
 ? $_[1]->{-namedb}
 : (($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]} ||{})->{-namedb} ||$_[1])
}


sub cfpv {	# Field Player: field value
		# (self, field || fieldname) -> value
 my $f =ref($_[1])
	? $_[1]
	: ($_[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
 ? []
 : !$f->{-values}
 ? (!$f->{-labels}
	? []
	: (do{  local $_ =cfpv(@_);

lib/ARSObject.pm  view on Meta::CPAN 

		use locale;
		[sort {lc($ll->{$a}) cmp lc($ll->{$b})
			} keys %$ll]}))
 : ref($f->{-values}) eq 'CODE'
 ? (do{	local $_ =cfpv(@_);
	&{$f->{-values}}($_[0], $f, $_)})
 : $f->{-values}
}


sub cfpvv {	# Field Player: field value or default
		# (self, field || fieldname) -> value
 my $v =cfpv(@_);
 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'

lib/ARSObject.pm  view on Meta::CPAN 

 : !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
 $_[0]->{-cgi}->param((ref($_[1])
		? $_[1]->{-namecgi} ||''
		: (($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]} ||{})->{-namecgi} ||$_[1])
	) .'__PV_')
}


sub cfpvc {	# Field Player: field value changed since form open?
		# (self, field || fieldname) -> changed?
 my ($v1, $v0) =(cfpv(@_), cfpvp(@_));
   defined($v1) && defined($v0)
 ? $v1 ne $v0
 : !defined($v1) && !defined($v0)
 ? 0
 : 1
}


sub cfpvcc {	# Field Player: field value changed in the last form submit?
		# (self, field || fieldname) -> changed?
 my $f =ref($_[1])
	? $_[1]
	: ($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]});
 my $fn =ref($f) ? $f->{-namecgi} ||'' : '';
 $f->{-onchange} ||$f->{-values}
 ? $_[0]->{-cgi}->param("${fn}__C_") ||!defined($_[0]->{-cgi}->param("${fn}__C_"))
 : cfpvc(@_)
}


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];

lib/ARSObject.pm  view on Meta::CPAN 

				if $u 
				&& !exists($f1->{-labels}->{$v})
				&& (defined($f1->{-lbtran}) && !$f1->{-lbtran})
		}
	}
 }
 $r
}


sub cfprun {	# Field Player: run
		# (self, msg sub{}
		# , form row sub{}, form top, form bottom) -> success
 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\""

lib/ARSObject.pod  view on Meta::CPAN 



=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>().



( run in 0.244 second using v1.01-cache-2.11-cpan-4d50c553e7e )