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
,-meta => {} # Forms metadata from ARS:
# {formName}->{-fields}->{fieldName}=>{}
# {formName}->{-fldids}->{fieldId}=>{}
# Additional parameters may be:
# ,'fieldLbl' =>label
# ,'fieldLbll'=>label localised
# ,'fieldLblc'=>label catenation/comment
# ,'fieldLbv' =>labels of values
# ,'fieldLbvl'=>labels of values localised
# ,'indexUnique'
# ,'strOut'|'strIn'=>sub(self,form,{field},$_=val){}
#,-meta-min # Used in 'arsmetamin' operation
#,-meta-sql # 'arsmetasql': {tableName}->{-cols}->{sqlName}=>{fieldName, sqlName,...}
# {tableName}->{-fields}->{fieldName}=>sqlName
# {tableName}->{-ids}->{fieldId}=>sqlName
# {-forms}->{formName}->{tableName}
# also: -sqlname, -sqlntbl, -sqlncol, -sqlninc
# -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) =@_;
foreach my $k (keys %a) {
$s->{$k} =$a{$k}
}
if ($a{-die}) {
lib/ARSObject.pm view on Meta::CPAN
eval('use ' .$a{-die} .';');
$s->{-die} =\&Carp::confess;
$s->{-warn}=\&Carp::carp;
}
elsif ($a{-die} =~/^CGI::Carp/) {
eval('use ' .$a{-die} .';');
$s->{-die} =\&CGI::Carp::confess;
$s->{-warn}=\&CGI::Carp::carp;
if ($s->{-diemsg}) {
my $dm =$s->{-diemsg};
CGI::Carp::set_message(sub{&$dm(@_); $s->disconnect() if $s;})
}
}
elsif ($a{-die} =~/^CGI::Die/) {
eval('use Carp;');
$s->{-die} =\&Carp::confess;
$s->{-warn}=\&Carp::carp;
my $sigdie =$SIG{__DIE__};
$SIG{__DIE__} =sub{
return if ineval();
if ($s && $s->{-diemsg}) {
&{$s->{-diemsg}}(@_)
}
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 {
print '<div style="font-weight: bolder">Warnig: '
, $s->{-cgi}->escapeHTML($_[0])
, "<div>\n"
if $s && $s->{-cgi}
}
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)
}
closedir(FILE);
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);
if (ref($_[0]->{$_[1]}) eq 'ARRAY') {
$rr =[];
for(my $i=0; $i<=$#{$_[0]->{$_[1]}}; $i++) {
if (!defined(eval{$v =&{$_[2]}($_[0], $_[1], $i, $_ =$_[0]->{$_[1]}->[$i])}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$_[0]->{-die}}($_[0]->efmt($@,$_[0]->{-cmd})));
}
elsif ($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}) {
$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
foreach my $kh (keys %{$s->{$f}}) {
$s->{$kk}->{$s->{$f}->{$kh}->{$k}} =$s->{$f}->{$kh}
if defined($s->{$f}->{$kh}->{$k})
}
}
}
if (ref($v) eq 'CODE') {
my ($rh, $t) =({});
local $_;
local $_[0]->{-cmd} =($_[0]->{-cmd} ? $_[0]->{-cmd} .': ' : '')
."vfhash('$f', '$k', sub{})";
foreach my $ke (keys %{$s->{$kk}}) {
if (!defined(eval{$t =&$v($s, $f, $k, $_ =$s->{$kk}->{$ke})}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$s->{-die}}($s->efmt($@,$s->{-cmd})));
}
elsif ($t) {
$rh->{$ke} =$s->{$kk}->{$ke};
}
}
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++) {
if (!defined($s->{$f}->[$i]->{$k})) {
}
elsif ($v && !defined(eval{$t =&$v($s, $f, $k, $_ =$s->{$f}->[$i])}) && $@) {
last if $@ =~/^last[\r\n]*$/;
next if $@ =~/^next[\r\n]*$/;
return(&{$s->{-die}}($s->efmt($@,$s->{-cmd})));
}
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'
#
# -fields => [{fieldId=>1, columnWidth=>9, separator=>"\t"},...
# ,[{fieldName=>name, width=>9},...
# ,[{field=>name|id, width=>9},...] # 128 bytes limit strings
# ||-fields => [fieldId | fieldName,...] # using ars_GetListEntryWithFields()
# ||-fields => '*' | 1 | '*-$', -xfields=>sub{} || [fieldName| fieldId,...]
# ||-fetch => '*' | 1 | [fieldId|fieldName,...] # using ars_GetEntry() for each record
# -order ||-sort => [fieldId, (1||2),...] # 1 - asc, 2 - desc
# [..., fieldName, field=>'desc', field=>'asc',...]
# -limit ||-max => maxRetrieve
# -first ||-start => firstRetrieve
# -for ||-foreach => sub(self, form, id|string, ?{record}){die "last\n", die "next\n"} -> self
# ?-echo=>1
#
# ars_GetListEntry(ctrl, schema, qualifier, maxRetrieve=0, firstRetrieve=0,...)
# ..., getListFields, sortList,...
# ars_LoadQualifier(ctrl, schema, qualifier string)
#
# Using the advanced search bar:
# 'Currency Field.VALUE' 'Currency Field' = $NULL$
# ??? BookValue=> {conversionDate=> 1090544110, currencyCode=> 'USD', funcList=> [{currencyCode=> 'USD', value=> '0.00'}, {currencyCode=> 'EUR', value=> ''}, {currencyCode=> 'GBP', value=> ''}, {currencyCode=> 'JPY', value=> ''}, {currencyCode=> 'CA...
# 'Status History.Fixed.TIME' < "07/01/99"
lib/ARSObject.pm view on Meta::CPAN
my @fs;
{my ($v, $x, @r) =($a{-sort} ||$a{-order});
@fs = $v
? (map {if (!$x) {$x =$_; @r=()}
elsif(/^(desc|2)$/) {@r =($x=~/^\d+$/ ? $x : schdn($s,$f,$x)->{fieldId}, 2); $x =undef}
else {@r=($x =~/^\d+$/ ? $x : schdn($s,$f,$x)->{fieldId},1); $x=undef if /^(asc|1)$/}
@r} @$v)
: ();
push @fs, $x =~/^\d+$/ ? $x : schdn($s,$f,$x)->{fieldId}, 1
if $x}
my $q =$s->_qsubst('',$a{-qual} ||$a{-query} ||$a{-where}, $f);
$s->{-cmd} .=": subst(-from=>'$f'"
.(@$fl ? ',-fields=>' .join(', ', map {ref($_) ? "'" .$_->{fieldId} ."'(" .$_->{columnWidth} .")" : "'$_'"
} @$fl) : '')
.($q ? ",-where=>$q" : '')
.(@fs ? ',-order=>' .join(', ', map {"'$_'"} @fs) : '')
.")"
if 0;
$q =ARS::ars_LoadQualifier($s->{-ctrl}, $f, $q);
return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd})))
if !$q;
$s->{-cmd} .=": qual". $s->dsquot(ARS::ars_perl_qualifier($s->{-ctrl}, $q))
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 =''
}
elsif (substr($2,0,1) eq "'") {
if ($q =~/^([^']+)'(.*)/) {
$q =$2;
my $n =$1;
$r .="'" .($n =~/^\d+$/ ? $n : schdn($s,$f,$n)->{fieldId}) ."'";
}
else {
$r .="'"
}
}
else {
$r .=_qsubst($s, $2, $q, $f)
}
}
$r .=$q if defined($q);
}
elsif ($c eq '(') {
$r =$c;
while ($q =~/^(.*?)([()'"])(.*)/) {
$q =$3;
$r .=$1;
if ($2 eq ')') {$r .=$2; last}
else {$r .=_qsubst($s, $2, $q, $f)}
}
$_[2] =$q;
}
elsif ($c =~/['"]/) {
my $cq =$s->strquot($c);
$cq =substr($cq,1,-1);
$r =$c;
while ($q =~/^(.*?)(\Q$c\E|\Q$cq\E)(.*)/) {
$q =$3;
$r .=$1 .$2;
last if $2 eq $c;
}
$_[2] =$q;
}
elsif ($c eq ',') {
my @r;
while ($q =~/^(.*?)(['"(]|\Q$c\E)(.*)/i) {
$q =$3;
$r .=$1;
if ($2 eq $c) {
push @r, ($r =~/^\s*(.*?)\s*$/ ? $1 : $r);
$r ='';
}
else {
$r .=_qsubst($s, $2, $q, $f);
}
}
$r .=$q;
push @r, ($r =~/^\s*(.*?)\s*$/ ? $1 : $r) if $r ne '';
return(@r)
}
else {
$r =$c .$q
}
$r
}
sub entry { # ars_GetEntry
# (-from=>form, -id=>entryId, ?-for=>{}, ?-fields=>[internalId,...])
# -> {fieldName => value}
# # Field Ids translated using -schdn/-schid
# -from ||-form ||-schema => schema name
# -id => entryId
# -fields => [internalId, fieldName,...]
# -for => {} # steady hash to store each entry fetched
# ?-echo=>1
#
# ars_GetEntry(ctrl,schema,entry_id,...) -> (internalId => value,...)
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
$rd =$s->dbiquery($fpksql .$s->{-dbi}->quote($r->{$fpk->{fieldName}}))->fetchrow_hashref();
my $ru;
foreach my $f (@flds) {
next if !$f->{fieldName} || !$f->{COLUMN_NAME} || !$f->{TYPE_NAME}
|| !exists($r->{$f->{fieldName}});
$rw->{$f->{fieldName}} =!defined($r->{$f->{fieldName}})
? $r->{$f->{fieldName}}
: $f->{TYPE_NAME} eq 'datetime'
? strtime($s, $r->{$f->{fieldName}})
: ($f->{dataType} =~/^(?:char)$/) && $f->{COLUMN_SIZE}
? substr($r->{$f->{fieldName}}, 0, $f->{COLUMN_SIZE_DB} ||$f->{COLUMN_SIZE})
: $r->{$f->{fieldName}};
$rd->{$f->{COLUMN_NAME}} =$1
if $rd
&& defined($rd->{$f->{COLUMN_NAME}})
&& ($f->{TYPE_NAME} =~/^(?:datetime|float)$/)
&& ($rd->{$f->{COLUMN_NAME}}=~/^(.+)\.0+$/);
$rd->{$f->{COLUMN_NAME}} =defined($rw->{$f->{fieldName}}) && ($rw->{$f->{fieldName}} =~/\.(\d+)$/)
? sprintf('%.' .length($1) .'f', $rd->{$f->{COLUMN_NAME}})
: $rd->{$f->{COLUMN_NAME}} =~/^(.+)\.0+$/
? $1
: $rd->{$f->{COLUMN_NAME}}
if $rd
&& defined($rd->{$f->{COLUMN_NAME}})
&& ($f->{TYPE_NAME} eq 'float');
$rd->{$f->{COLUMN_NAME}} =substr($rd->{$f->{COLUMN_NAME}}, 0, $f->{COLUMN_SIZE_DB} ||$f->{COLUMN_SIZE})
if $rd
&& defined($rd->{$f->{COLUMN_NAME}})
&& ($f->{dataType} =~/^(?:char)$/) && $f->{COLUMN_SIZE};
$ru =1 if $rd
&& (defined($rd->{$f->{COLUMN_NAME}})
? !defined($rw->{$f->{fieldName}})
|| ($rd->{$f->{COLUMN_NAME}} ne $rw->{$f->{fieldName}})
: defined($rw->{$f->{fieldName}}));
}
if (!$rd) {
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 : "''";
my $qiq=$s->{-dbi}->quote_identifier('"w') =~/^([^w]+)w/ ? $1 : '""';
my $qit=$qi .'.' .$qi;
my $sr ='';
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} : '')
cmp (defined($a{-labels0}->{$b}) ? $a{-labels0}->{$b} : '')
} keys %{$a{-labels0}}
: ()
, (sort {(defined($a{-labels}->{$a}) ? $a{-labels}->{$a} : '')
cmp (defined($a{-labels}->{$b}) ? $a{-labels}->{$b} : '')
} keys %{$a{-labels}})
lib/ARSObject.pm view on Meta::CPAN
my $ac=$a{-class} ? ' class="' .$a{-class} .'"' : '';
my $as=$a{-style} ? ' style="' .$a{-style} .'"' : '';
my $aw=$a{-size} ||80;
my $v =!defined($s->{-cgi}->param($n)) ||$a{-override}
? $a{-default}
: $s->{-cgi}->param($n);
$v =&$av()->[0]
if $a{-strict} && (!defined($v) || !grep /^\Q$v\E$/, @{&$av()});
$s->{-cgi}->param($n, defined($v) ? $v : '');
my $ek =$s->{-cgi}->user_agent('MSIE') ? 'window.event.keyCode' : 'event.which';
my $fs =sub{
'{var k;'
."var l=window.document.forms[0].$nl;"
."if(l.style.display=='none'){"
.($_[0] eq '4' ? '' : 'return(true)') .'}else{'
.(!$_[0] # onkeypess - input
? "if (String.fromCharCode($ek) ==\"\\r\") {${n}__S_.focus(); ${n}__S_.click(); return(true)}; k=window.document.forms[0].$n.value +String.fromCharCode($ek);"
: $_[0] eq '1' # onkeypess - list -> input (first char)
? "if (String.fromCharCode($ek) ==\"\\r\") {${n}__S_.focus(); ${n}__S_.click(); return(true)}; window.document.forms[0].$n.focus(); k=window.document.forms[0].$n.value =String.fromCharCode($ek); "
: $_[0] eq '2' # onkeypess - list -> prompt (selected char)
# ? "k=prompt('Enter search string',String.fromCharCode($ek));"
? "if (String.fromCharCode($ek) ==\"\\r\") {${n}__S_.focus(); ${n}__S_.click(); return(true)}; k =String.fromCharCode($ek); for (var i=0; i <l.length; ++i) {if (l.options.item(i).value.toLowerCase().indexOf(k)==0 || l.options.item(i).text....
: $_[0] eq '3' # button - '..'
? "k=prompt('Enter search substring',''); $nl.focus();"
: $_[0] eq '4' # onload - document
? "k=window.document.forms[0].$n.value; window.document.forms[0].$nl.focus();"
: ''
)
.'if(k){'
.'k=k.toLowerCase();'
.'for (var i=0; i <l.length; ++i) {'
.($_[0] eq '4'
? 'if (l.options.item(i).value.toLowerCase() ==k){'
: $s->{-cgi}->user_agent('MSIE')
lib/ARSObject.pm view on Meta::CPAN
? ($_ => $a{-textfield}->{$_})
: ()
} qw(-name -title -class -style -size -maxlength))
, -default=>$v
, -override=>1
, ($a{-strict} && !$s->{-cgi}->param("${n}__O_")
? (-readonly=>1) # ,-hidefocus=>0, -disabled=>0
: ())
)
.($s->{-cgi}->param("${n}__O_")
? ("<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
."<input type=\"hidden\" name=\"${n}__P_\" value=\"" .(defined($v) ? $s->{-cgi}->escapeHTML($v) : '') ."\"$ac$as />\n"
."<br />\n"
."<select name=\"${n}__L_\" title=\"select value\" size=\"10\""
."$ac$as"
." ondblclick=\"{${n}__S_.focus(); ${n}__S_.click(); return(true)}\""
." onkeypress=\"" .($s->{-cgi}->user_agent('MSIE') ? &$fs(1) : &$fs(2))
."\">\n"
.join('',map {'<option'
.((defined($v) ? $v : '') eq (defined($_) ? $_ : '') ? ' selected' : '')
.' value="' .$s->{-cgi}->escapeHTML(defined($_) ? $_ : '') .'">'
.$s->{-cgi}->escapeHTML(
!defined($_)
? ''
: !$a{-labels}
? (length($_) > $aw ? substr($_,0,$aw) .'...' : $_)
: defined($a{-labels}->{$_})
? (length($a{-labels}->{$_}) > $aw ? substr($a{-labels}->{$_},0,$aw) .'...' : $a{-labels}->{$_})
: '') ."</option>\n"
} @{&$av()})
."</select>\n"
."<input type=\"submit\" name=\"${n}__S_\" value=\"<\" title=\"set\"$ac$as />"
.$s->{-cgi}->button(-value=>'...', -title=>'find', -onClick=>&$fs(3))
."<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
."</div>\n"
."<script for=\"window\" event=\"onload\">{window.document.forms[0].${n}__L_.focus()}</script>"
)
: ("<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';
$a{-to} =&{$a{-to}}($s,\%a) if ref($a{-to}) eq 'CODE';
$a{-to} =[grep {$_} split /\s*[,;]\s*/, ($a{-to} =~/^\s*(.*)\s*$/ ? $1 : $a{-to})]
if $a{-to} && !ref($a{-to}) && ($a{-to} =~/[,;]/);
$a{-sender} =$a{-sender} ||$a{-from};
$a{-recipient} =$a{-recipient} ||$a{-to};
$a{-recipient} =&{$a{-recipient}}($s,\%a) if ref($a{-recipient}) eq 'CODE';
$a{-recipient} =[grep {$_} split /\s*[,;]\s*/, ($a{-recipient} =~/^\s*(.*)\s*$/ ? $1 : $a{-recipient})]
if $a{-recipient} && ref($a{-recipient}) && ($a{-recipient} =~/[,;]/);
return(&{$s->{-die}}("SMTP e-mail recipients not defined"))
if !$a{-recipient};
if (!defined($a{-data})) {
my $koi =(($a{-charset}||$s->charset()||'') =~/1251/);
$a{-subject} = ref($a{-subject}) eq 'CODE'
? &{$a{-subject}}($s,\%a)
: 'ARSObject'
if ref($a{-subject}) ||!defined($a{-subject});
$a{-data} ='';
$a{-data} .='From: ' .($koi ? $s->cptran('ansi','koi',$a{-from})
: $a{-from})
."\cM\cJ";
$a{-data} .='Subject: '
.($koi
? $s->cptran('ansi','koi',$a{-subject})
: $a{-subject}) ."\cM\cJ";
$a{-data} .='To: '
.($koi
? $s->cptran('ansi','koi', ref($a{-to}) ? join(', ',@{$a{-to}}) : $a{-to})
: (ref($a{-to}) ? join(', ',@{$a{-to}}) : $a{-to}))
."\cM\cJ"
if $a{-to};
foreach my $k (keys %a) {
next if $k =~/^-(data|subject|html|text|from|to|sender|recipient)$/;
next if !defined($a{$k});
my $n =$k =~/^-(.+)/ ? ucfirst($1) .':' : $k;
$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";
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:
# join(' ',@{[soon,...arg]}) used to clean schedule
# join('', @{[arg,...]}) used in soon command
my ($s, $mm, $lf, $cr, $cs) =@_;
$lf =$s->vfname($lf) if $lf && ($lf !~/[\\\/]/);
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
$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$/);
}
}
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];
!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})
lib/ARSObject.pm view on Meta::CPAN
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))) {
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\""
.($_[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]))
};
$cfld =sub{"\n<tr><th align=\"left\" valign=\"top\">"
. ($_[1]->{-namehtml}
? &{$_[1]->{-namehtml}}(@_)
: $_[0]->{-cgi}->escapeHTML($_[1]->{-namelbl}||''))
. "</th>\n<td align=\"left\" valign=\"top\">"
. $_[2]
. "</td></tr>"
}
if !$cfld;
$cfld0="\n<table>" if !$cfld0;
$cfld1="\n</table>" if !$cfld1;
lib/ARSObject.pm view on Meta::CPAN
$bb .=' ' if $bb;
$bb .= exists($f->{-widget}) && !$f->{-widget}
? ''
: !ref($f->{-widget}) && $f->{-widget}
? $f->{-widget}
: ref($f->{-widget}) eq 'CODE'
? &{$f->{-widget}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
: !$f->{-namecgi}
? ''
: ref($f->{-widget}) eq 'HASH'
? $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
, %{$f->{-widget}})
: $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
, map {defined($f->{$_}) ? ($_=>$f->{$_}) : ()} qw(-class -style));
next
}
elsif ($bb) {
print &$cfld($s, {}, $bb);
$bb ='';
}
print &$cfld($s
, $f->{-action} ||$f->{-preact}
? {}
lib/ARSObject.pm view on Meta::CPAN
? $s->cgiselect(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -onchange=>1
, map {defined($f->{$_}) ? ($_=>$f->{$_}) : ()} qw(-values -labels)
, -id => $f->{-namecgi}
, %{$f->{-widget}})
: $f->{-rows}
? $s->cgitext(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, %{$f->{-widget}})
: $f->{-action} ||$f->{-preact}
? $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
, -id => $f->{-namecgi}
, %{$f->{-widget}})
: $s->cgistring(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, %{$f->{-widget}})
)
: ( $f->{-values}
? $s->cgiselect(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, -onchange=>1
, map { my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
defined($v) ? ($_=>$v) : ()} qw(-values -labels -onchange -readonly -disabled -class -style))
: $f->{-rows}
? $s->cgitext(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, map { my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
defined($v) ? ($_=>$v) : ()} qw(-rows -columns -maxlength -readonly -class -style))
: $f->{-action} ||$f->{-preact}
? $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
, -id => $f->{-namecgi}
, map { my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
defined($v) ? ($_=>$v) : ()} qw(-class -style))
: $s->cgistring(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, map { my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
defined($v) ? ($_=>$v) : ()} qw(-size -maxlength -readonly -disabled -class -style))
)
)
. (!$f->{-widget1}
lib/ARSObject.pod view on Meta::CPAN
,'1000000001' => {fieldName=>'Company'}
,'200000020' => 'Name'
});
$s->connect();
my $hac ={};
$s->query(-from=>'BMC.CORE:BMC_ComputerSystem'
,-where=>"('DatasetId'=\"BMC.ASSET\")"
." AND ('Company'=\"$company\")"
,-fields=>['Name', 'ModifiedDate', 'RequestId', 'InstanceId', 'ShortDescription', 'InstanceId', 'DatasetId', 'TokenId', 'OwnerName', 'OwnerContact', 'TagNumber', 'Description', 'HostName', 'Domain', 'Workgroup', 'CMDBRowLevelSecurity', 'Company', ...
,-order=>['Name']
,-for=>sub{$hac->{$_[3]->{Name}} =$_[3];
}
);
print $s->dsdump($hac);
=head1 DESCRIPTION
This module is intended for capable scripts above L<ARS|ARS> module
(L<../../ARSPerl/index.html>).
It caches metadata alike L<Remedy::ARSTools|Remedy/ARSTools>,
but uses L<Data::Dumper|Data/Dumper> or L<Storable|Storable> module.
And metadata model is directly given from ARS::ars_GetFieldTable()/ARS::ars_GetField(),
unlike L<ARSOOForm|ARSOOForm> and L<Remedy::ARSTools|Remedy/ARSTools>.
And additional description level (C<-metadn>/C<-metaid>) added to unify field names
and extend conversion capabilities of field values.
Field names and values are translated (C<-strFields>/C<strIn>/C<strOut>)
as possible.
C<query>() method supports iterator sub{} and uses ARS::ars_GetListEntry(),
ARS::ars_GetListEntryWithFields(), ARS::ars_GetEntry() calls
as appropriate with parameters given.
C<entry>(), C<entryIns>(), C<entryUpd>(), C<entryDel>() methods
are usual to manipulate records.
C<entryNew>() method may be used to form new record hash with default values for C<entryIns>().
C<entryDif>() method may be used to minimise data for C<entryUpd>().
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
* do not store: C<-name>.., C<-entryIns>=>0, C<-entryUpd>=>0, C<-vfstore>=>0
* list&refresh: C<-name>.., C<-onchange>=>1, C<-labels>, C<-values>
* optional button field: C<-name>.., C<-action>=>1, C<-used>=>condition
=item CGI Form Presenter - Field Definitions
(for each field inside C<CGI Form Presenter - Fields>)
C<-name>, C<-namecgi>, C<-namedb>, C<-metadb> => 'field name'
C<-namelbl>, C<-namecmt> => 'text for user'
C<-namehtml> => sub{} -> 'html for user'
C<-formdb> => 'name', C<-record> => 'name' || 'nameRowNumber'
C<-used>, C<-unused> => boolean || 'field name' || ['field',...] || condition sub{}
C<-entryIns>, C<-entryUpd>, C<-vfstore> => !exists ||false
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
Field definitions may be used also:
C<-action> => 1;
C<-labels>, C<-values>;
C<-disabled>, C<-readonly>, C<-hidden>, C<-onchange> => boolean.
C<-widget0> => html above C<-widget> || sub{} -> html
C<-widget1> => html below C<-widget> || sub{} -> html
=back
=head1 SLOTS
=over
=item Slots
=item -action
=> not exists
|| sub{}({self}, action, '-action'
, {key field}, $_= key value, key pv
, {field db name=>value,..}, prev return)
-> success || {field db name => value}
|| 'entryIns' || 'entryUpd' || 'entryDel' || 'entrySave'
|| 1
(C<CGI Form Presenter - Field Definitions>)
Action to execute after the form performance,
should be at the top of the form, before C<-key> fields.
May be several actions with the same C<-namecgi>.
lib/ARSObject.pod view on Meta::CPAN
(C<Utility Objects>)
L<CGI|CGI> utility object.
See also C<cgi> method.
=item -change
=> not exists
|| {field name => value || sub{}({self}, {field}, $_ =value),..}
|| {value=>{field name => value,..},..}
(C<CGI Form Presenter - Field Definitions>)
Change field values when this field changed.
This may be defined also as C<-values> or C<-labels>.
=item -computed
=> 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()
lib/ARSObject.pod view on Meta::CPAN
=> 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
=> entryIns()
(C<ARS methods>)
The logical number of the entry inserted by C<entryIns>().
=item -error
=> not exists
|| sub{}({self}, {field}, $_ =field value, previous value) -> 'error text'
|| 'error text for empty field'
(C<CGI Form Presenter - Field Definitions>)
Field value error evaluator
See also C<-warn>.
=item -fpl
lib/ARSObject.pod view on Meta::CPAN
=> => not exists || boolean
(C<CGI Form Presenter - Field Definitions>)
Key database field?
=item -labels
=> not exists || {value=>label,..} || {value=>{{-label=>label, field=>value,..},..}
|| sub{}({self},{field},$_=value) -> {value=>label,..}
(C<CGI Form Presenter - Field Definitions>)
Labels for the drop-down list box field.
If no C<-values>, this will be generated automatically.
Special {-name=>name, field=>value,..} form is to define C<-change>.
See also C<-values>.
=item -lbtran
lib/ARSObject.pod view on Meta::CPAN
=item -namelbl
=> not exists || 'field label'
=item -namecmt
=> not exists || 'comment text'
=item -namehtml
=> not exists || sub{}(self, {field}, 'widget html') -> 'label html'
(C<CGI Form Presenter - Field Definitions>)
Field names, label, comment text.
If C<-name> exists, it's value may be used as C<-namedb>,
and escaped value may be used as C<-namecgi>.
=item -maxRetrieve
=> 0 || number of rows
lib/ARSObject.pod view on Meta::CPAN
Futher data model is directly given from ARS::ars_GetFieldTable()/ARS::ars_GetField()
excluding C<-metax>.
Additional parameters may be:
'fieldLbl' => label, 'fieldLblc' => label cmt
=item -metaid
=> {fieldId => {fieldName=>'name',FieldId=>id, strIn|strOut=>sub{}},...}
=item -metadn
=> {fieldName => {fieldName=>'name',FieldId=>id, strIn|strOut=>sub{}},...}
(C<Metadata>)
Commonly used fields with common names and value translation.
Data translation sub{}s may be specified as
'strOut'|'strIn' => sub(self,form,{field},$_=value){} -> translated value.
This sub{}s may use C<strOut>() and C<strIn> methods.
=item -metax
=> ['displayInstanceList','permissions']
(C<Metadata>)
Field parameters to exclude from C<-meta> to decrease memory usage.
lib/ARSObject.pod view on Meta::CPAN
{tableName}->{-fields}->{fieldName}=>sqlName
{tableName}->{-ids}->{fieldId}=>sqlName
{-forms}->{formName}->{tableName}
=item -preact
=> not exists
|| sub{}({self}, action, '-preact'
, {key field}, $_= key value, key pv
, {field db name=>value,..})
-> success || {field db name => value}
|| 'vfentry' || 'vfhash' || 'entry' || 'entryNew'
(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).
lib/ARSObject.pod view on Meta::CPAN
=> 'record name' || 'nameRowNumber'
(C<CGI Form Presenter - Field Definitions>)
Record name, if several records in screen,
may be defined as a special C<-fpl> entry after C<-formdb> entry.
Record name may be followed by row number.
=item -reset
=> 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...]
lib/ARSObject.pod view on Meta::CPAN
=> 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>().
lib/ARSObject.pod view on Meta::CPAN
(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
(C<CGI Form Presenter - Field Definitions>)
Default field value or field value evaluator.
See also C<-computed>.
=item -values
=> not exists || [value,..] || [{-name=>name, field=>value,..},..]
|| sub{}({self},{field},$_=value) -> [value,..]
(C<CGI Form Presenter - Field Definitions>)
Values for the drop-down list box field
Special {-name=>name, field=>value,..} form is to define C<-change>.
See also C<-labels>.
=item -vfbase
lib/ARSObject.pod view on Meta::CPAN
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
=> not exists
|| sub{}({self}, {field}, $_ =field value, previous value) -> 'warning text'
|| '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.
=item -widget0
=item -widget1
=> not exists || 'html'
|| sub{}({self}, {field}, value, previous value) -> html
(C<CGI Form Presenter - Field Definitions>)
html to display above and below C<-widget>
=back
lib/ARSObject.pod view on Meta::CPAN
(C<ARS methods>)
Use object->arsXXX() syntax for ARS:ars_XXX(ctrl,...) calls.
=item cfpaction ({action} || 'action', '-preact'||'-action', {key field}) -> success
(C<CGI Form Presenter>)
Action evaluator, called from C<cfprun>(),
may be called from C<-action> or C<-preact> sub{}.
=item cfpl ('field name' || {field definition}) -> [possible field values]
(C<CGI Form Presenter>)
List of C<-values> of the field, may be used in sub{}s executed by C<cfprun>.
=item cfpp ('field name' || {field definition}) -> previous field value
(C<CGI Form Presenter>)
Previous value of the field, may be used in sub{}s executed by C<cfprun>.
=item cfprun (? msg sub{}(self, 'label', 'comment'), ? form row sub{}(self, {field}, 'html'), ? 'form start html', ? 'form end html') -> success
(C<CGI Form Presenter>)
Evaluate C<-fpl> and present html form with actions.
The order of the fields is important, it is preferred to refer from
the field definition to previous fields, not to subsequent.
=item cfpv ('field name' || {field definition}) -> current field value
(C<CGI Form Presenter>)
Current value of the field, may be used in sub{}s executed by C<cfprun>.
=item cfpvv ('field name' || {field definition}) -> current or default field value
(C<CGI Form Presenter>)
Current or default value of the field, may be used in sub{}s executed by C<cfprun>.
=item C<cgi> () -> CGI object
=item C<cgi> (CGI->new args) -> CGI object
(C<Utility Objects>)
Access to L<CGI|CGI> object in C<-cgi>.
It will be automatically created with C<cgiconnect>() if not exists.
lib/ARSObject.pod view on Meta::CPAN
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>
lib/ARSObject.pod view on Meta::CPAN
-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
lib/ARSObject.pod view on Meta::CPAN
-form | -into | -schema => schema or form name
-id=>entryId
-echo=>1 # output command to STDOUT
field === internalId | fieldName
=item fdirls (?-opt, path, ? filter sub{}(self, path, $_ =entry)) -> (entry,...)
=item fdirls (..., []) -> [entry,...]
(C<Utility Methods>)
List directory contents.
=item fload (?-opt, filename) -> content
lib/ARSObject.pod view on Meta::CPAN
=item new (param => value,...) -> ARSObject
(C<Creation and Configuration>)
Create ARSObject.
=item query (-form => schema name, -where => condition,...) -> list of records
=item query (..., -for => sub(self, form, id|string, ?{record}){die "last\n", die "next\n"}) -> self
(C<ARS methods>)
Query records from ARS.
Field names are translated to ids using C<-metadn>/C<-meta>.
Result set values are translated with C<strOut> when C<-strFields>.
Values in the query condition should be converted to ARS representation explicitly:
strings should be quoted with C<arsquot>(), dates - converted with C<timestr>().
lib/ARSObject.pod view on Meta::CPAN
-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.
# use '*-$' to excude currency and attachment fields.
# use '*-f' to excude attachment fields.
-fetch => '*' | 1 | [fieldId|fieldName,...]
# result set is hash refs for each record, ars_GetEntry() used for each row, this is slow.
-where | -query => search condition string
# Syntax:
'fieldId' || 'fieldName' - fields;
lib/ARSObject.pod view on Meta::CPAN
digits - numeric value, number of seconds as date value;
strIn(form, fieldName, value) - to encode value for '-where'
-order | -sort => [fieldId | fieldName => (1||2) | ('asc'|'desc'),...]
# sort order, 1 - asc, 2 - desc
-first ||-start => firstRetrieve # ARS::ars_GetListEntry() parameter
-limit ||-max => maxRetrieve # ARS::ars_GetListEntry() parameter
-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
lib/ARSObject.pod view on Meta::CPAN
=item smtpconnect (?-smtphost=> name) -> Net::SMTP object
(C<Utility Objects>)
Connect to L<Net::SMTP|Net/SMTP> host using C<-smtphost>.
=item smtpsend (-from || -sender => name, -to || -recipient => [name,...], -data => smtp data || (-subject => string, -text || -html => text)) -> Net::SMTP::dataend
(C<Utility Objects>)
Send L<Net::SMTP|Net/SMTP> e-mail using C<smtp>.
=item soon (minutes number || sub{}, logfile ||'', run command || [command line] || sub{}, soon command || [command line] || [])
=item soon (minutes number || sub{}, logfile ||'', run command || [command line] || sub{})
=item soon (minutes number || sub{}, logfile ||'', '', soon command || [command line])
Execute the script periodically, run command immediately, soon command after delay specified.
Log file name may be full file name, else C<vfname>(file name) will be used.
If run command is empty, soon command will be scheduled.
If soon command is empty, sleep(minutes*60) will be used, otherwise 'at' MSWin32 scheduling command.
If !defined(minutes), soon command will be deleted from schedule and run command will be executed once.
=item sqlname (formName, ?fieldName, ?forceMetaUpd) -> sql name
lib/ARSObject.pod view on Meta::CPAN
Used by C<arsmetasql>().
Uses C<-sqlname>, C<-sqlntbl>, C<-sqlncol>, C<-sqlninc> settings.
=item strIn (schema, fieldId | fieldName | field metadata, value) -> converted
(C<ARS methods>)
Convert value for ARS internal field value representation.
Called automatically when C<-strFields>.
Should be called explicitly from C<strIn> sub{} in C<-metadn>/C<-metaid>.
May need to be called explicitly forming C<query> condition.
See also C<strOut>, C<-strFields>.
=item strOut (schema, fieldId | fieldName | field metadata, fieldValue) -> converted
(C<ARS methods>)
Convert ARS field value for external representation.
Called automatically when C<-strFields>.
Should be called explicitly from C<strOut> sub{} in C<-metadn>/C<-metaid>
and when parsing strings result from C<query>.
See also C<strIn>, C<-strFields>.
=item strquot (string) -> escaped and quoted with ''
=item strquot2 (string) -> escaped and quoted with ""
(C<Utility Methods>)
lib/ARSObject.pod view on Meta::CPAN
(C<Variable files>)
Clear data loaded from variables file by C<vfload>(-slotName).
Reset data buffers of C<vfdata>() and C<vfhash>().
=item vfdata (-slotName) -> data structure
=item vfdata (-slotName, index) -> numbered element of data array
=item vfdata (-slotName, filter sub{}(self, -slot, index, $_=elem)) -> [record,...]
(C<Variable files>)
Access to data of variables file.
Automatically C<fload>s it.
Data structure will be treated as an array ref when index or filter argument used.
=item vfdistinct (-slotName, keyName) -> [value,...]
=item vfdistinct (-slotName, keyName, filter sub{}(self, -slot, keyName, keyValue, $_=elem)) -> [value,...]
(C<Variable files>)
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".
=item vfload (partial file name || -slotName) -> data structure
=item vfload (-slotName, ?create, ?renew ||renew period seconds) -> data structure
(C<Variable files>)
Load data structure from variables file using C<fload> and C<-storable>/C<dsparse>.
File absent may be created.
File existed may be renewed immediatelly or if it is older then renew period.
If '-slotName' specified, this slot will contain loaded data structure.
If '-slotName-calc' => sub{}(self, -slotName) specified, file will not be used at all,
data will be calculated on demand.
If '-slotName-load' => sub{}(self, -slotName) specified, it will be used to fill unexisted file.
=item vfname (partial name || -slotName) -> full var file path name in the filesystem
(C<Variable files>)
Convert partial file name to full, based on C<-vfbase>, for variables file.
Leading '-' will be excluded.
=item vfrenew (-slotName, ?renew period seconds) -> vfstore()/vfload()
(C<Variable files>)
Renew variables file using C<vfstore>() inside C<vfload>() with '-slotName-load' sub{}.
If no period or when period ==1 file will be renewed immediatelly.
Else file will be renewed only if it is older then period.
=item vfstore (partial file name, data structure) -> success
=item vfstore (-slotName) -> success
(C<Variable files>)
DESCRIPTION
This module is intended for capable scripts above ARS module.
It caches metadata alike Remedy::ARSTools, but uses Data::Dumper or Storable module. And metadata model is directly given from ARS::ars_GetFieldTable()/ARS::ars_GetField(), unlike ARSOOForm and Remedy::ARSTools. And additional description level (-met...
Field names and values are translated as possible.
query() method supports iterator sub{} and uses ARS::ars_GetListEntry(), ARS::ars_GetListEntryWithFields(), ARS::ars_GetEntry() calls as appropriate with parameters given.
entry(), entryIns(), entryUpd(), entryDel() methods are usual to manipulate records.
entryNew() method may be used to form new record hash with default values for entryIns().
entryDif() method may be used to minimise data for entryUpd().
AUTOLOAD() method is to call 'ARS::ars_XXX' functions as methods.
Special processing added for 'HPD:Help Desk' ITSM Suite form.