ARSObject
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
,-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
lib/ARSObject.pm view on Meta::CPAN
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}
}
# CORE::warn($_[0]);
} if $^W;
}
}
elsif ($a{-vfbase}) {
if ($a{-vfbase} !~/[\\\/]/) {
lib/ARSObject.pm view on Meta::CPAN
,($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 .'"');
}
lib/ARSObject.pm view on Meta::CPAN
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++) {
$r =open(FILE, $f);
last if $r;
}
return(&{$s->{-die}}($s->efmt('$!',undef,'cannot open file','fstore',$f)))
if !$r;
if ($o =~/b/) {
binmode(FILE);
$r =defined(syswrite(FILE,$_[1]))
}
else {
$r =print FILE join("\n",@_[1..$#_])
}
close(FILE);
$r || &{$s->{-die}}($s->efmt('$!',undef,'Cannot write file','fstore',$f))
}
sub fload { # Load file
my $s =shift; # ('-b',filename) -> content
my $o =$_[0] =~/^-(?:\w[\w\d+-]*)*$/ ? shift : '-';
my($f,$f0) =($_[0],$_[0]);
if ($f =~/^[<>]+/) {$f0 =$'}
else {$f ='<' .$f}
print "fload('$f')\n" if $s->{-echo};
local *FILE;
my $r;
for (my $i =0; $i <$fretry; $i++) {
$r =open(FILE, $f);
last if $r;
}
return(&{$s->{-die}}($s->efmt('$!',undef,'Cannot open file','fload',$f)))
if !$r;
my $b =undef;
binmode(FILE) if $o =~/b/;
lib/ARSObject.pm view on Meta::CPAN
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
}
lib/ARSObject.pm view on Meta::CPAN
? 0
: ([stat $s->vfname('-meta')]->[9] ||0);
}
else {
$s->{-meta} ={};
}
foreach my $f (ref($s->{-schgen}) ? @{$s->{-schgen}} : @{$s->{-schema}}){
my $fa =ARS::ars_GetSchema($s->{-ctrl}, $f);
!$fa && return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetSchema',$f)));
if ($vfs && $s->{-meta}->{$f}) {
#print $s->strtime($fa->{timestamp}),'/',$s->strtime($vfs), "\n", $s->cpcon($s->dsdump($fa)), "\n"; exit(0);
next if $s->{-meta}->{$f} && $s->{-meta}->{$f}->{timestamp}
? (($s->{-meta}->{$f}->{timestamp}||0) >=($fa->{timestamp}||0))
&& ($vfs >=($fa->{timestamp}||0))
: $vfs >=($fa->{timestamp}||0 +60*60);
}
$vfu =1;
$s->{-meta}->{$f} ={}; # {} || $fa
$s->{-meta}->{$f}->{-fields} ={};
$s->{-meta}->{$f}->{timestamp} =$fa->{timestamp};
# $s->{-meta}->{$f}->{indexList} =$fa->{indexList};
lib/ARSObject.pm view on Meta::CPAN
delete $fm->{$e};
}
}
}
}
if (!$s->{-schgen}) {
}
else {
$vfu && $s->vfstore('-meta')
}
# print $s->cpcon($s->dsdump($s->{-meta})), "\n"; exit(0);
}
elsif (-e $s->vfname('meta')) {
$s->vfload('-meta');
# 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
lib/ARSObject.pm view on Meta::CPAN
if (ref($s->{-metaid})) {
foreach my $id (keys %{$s->{-metaid}}) {
$s->{-metaid}->{$id} ={fieldId=>$id, fieldName=>$s->{-metaid}->{$id}}
if !ref($s->{-metaid}->{$id});
$s->{-metaid}->{$id}->{fieldId} =$id;
$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})
lib/ARSObject.pm view on Meta::CPAN
$s->{'-meta-min'}->{$f} ={} if !$s->{'-meta-min'}->{$f};
$s->{'-meta-min'}->{$f}->{-fields} ={} if !$s->{'-meta-min'}->{$f}->{-fields};
$e ={%$e};
delete @$e{'owner','lastChanged', 'timestamp'};
$s->{'-meta-min'}->{$f}->{-fields}->{$ff} ={%$e};
}
}
$s->vfstore('-meta-min') if $s->{-schgen} && ($s->{-schgen} eq '1' ? !-e $s->vfname('-meta-min') : 1);
};
};
# print do($s->vfname('-meta-min'))||0,' ', $@||'', $s->vfname('-meta-min'),' ', "\n";
$s->vfload('-meta-min') if !$s->{'-meta-min'} && $s->{-schgen};
if (!$s->{-meta} ||!scalar(%{$s->{-meta}})) {
$s->{-meta} =$s->{'-meta-min'};
$s->arsmetaix();
}
else {
foreach my $f (keys %{$s->{'-meta-min'}}) {
next if $s->{-meta}->{$f};
my $fs =$s->{'-meta-min'}->{$f};
$s->{-meta}->{$f} ={}
lib/ARSObject.pm view on Meta::CPAN
}
}
foreach my $ff ('_arsobject_insert', '_arsobject_update', '_arsobject_delete') {
$s->sqlname($f,$ff,1);
$s->{'-meta-sql'}->{$s->sqlname($f)}->{-cols}->{$s->sqlname($f,$ff)}->{TYPE_NAME} ='int';
}
}
$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;
lib/ARSObject.pm view on Meta::CPAN
.($q ? ",-where=>$q" : '')
.(@fs ? ',-order=>' .join(', ', map {"'$_'"} @fs) : '')
.")"
if 0;
$q =ARS::ars_LoadQualifier($s->{-ctrl}, $f, $q);
return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd})))
if !$q;
$s->{-cmd} .=": qual". $s->dsquot(ARS::ars_perl_qualifier($s->{-ctrl}, $q))
if 0;
print $s->cpcon(join(";\n", split /\):\s/, $s->{-cmd})), "\n"
if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
if ($c && $a{-fields} && !ref($a{-fields}->[0])) {
my $id;
local $_;
foreach my $e (ARS::ars_GetListEntryWithFields($s->{-ctrl}, $f, $q
, $a{-limit} ||$a{-max} ||$s->{-maxRetrieve} ||0
, $a{-first} ||$a{-start} ||0
, $fl
, @fs)) {
lib/ARSObject.pm view on Meta::CPAN
# ?-echo=>1
#
# ars_GetEntry(ctrl,schema,entry_id,...) -> (internalId => value,...)
# no ars_GetEntryBLOB(ctrl,schema,entry_id,field_id,locType,locFile)
# no ars_EncodeDiary(diaryEntryHash1, ... diaryEntryHashN)
# encoded 'Status-History'
# decoded 'diary'
#
my ($s, %a) =@_;
my $f =$a{-schema} ||$a{-form} ||$a{-from};
print $s->cpcon("entry(-form=>'$f',-id=>'$a{-id}')\n")
if $s->{-echo} || $a{-echo};
my %r =ARS::ars_GetEntry($s->{-ctrl},$f,$a{-id}
,$a{-fields}
? (map {/^\d+$/ ? $_ : schdn($s, $f, $_)->{fieldId}} @{$a{-fields}})
: ()
);
if (%r) {
my $rr =$a{-for} ||{};
undef(@{$rr}{keys %$rr}) if %$rr;
# @{$rr}{map {schid($s,$f,$_)->{fieldName}} keys %r} =values %r;
lib/ARSObject.pm view on Meta::CPAN
}
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 $_;
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '') ."entryIns(-form=>'$f',"
.join(',', map {!defined($a{$_})
? "$_=>undef"
: ref($a{$_})
? ("$_=>" .dsquot($s, $a{$_}))
: ("$_=>" .strquot($s, $a{$_}))
} sort keys %a)
lib/ARSObject.pm view on Meta::CPAN
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")
if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
delete @a{qw(-schema -form -from -into -id -echo)};
local $_;
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
."entryUpd(-form=>'$f',-id=>'$id',"
.join(',', map {!defined($a{$_})
? "$_=>undef"
: ref($a{$_})
? ("$_=>" .dsquot($s, $a{$_}))
: ("$_=>" .strquot($s, $a{$_}))
lib/ARSObject.pm view on Meta::CPAN
$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
}
lib/ARSObject.pm view on Meta::CPAN
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
}
lib/ARSObject.pm view on Meta::CPAN
}
foreach my $r (@altc) {
push @sql
,'ALTER TABLE '
.join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $tbl)
.' ALTER COLUMN ' .$r;
}
}
}
foreach my $r (@sql) {
print "$r;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
$s->dbi()->do($r)
|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$r,undef,'dbidsmetasync'));
}
}
$s;
}
sub dbidsrpl { # DBI datastore - load data from ARS
my ($s, %arg) =@_;
lib/ARSObject.pm view on Meta::CPAN
}
$s->dbi() if !$s->{-dbi};
local $s->{-dbi}->{LongReadLen} =$s->{-dbi}->{LongReadLen} <= 1024 ? 4*64*1024 : $s->{-dbi}->{LongReadLen};
my $vts =$fts && $s->dbiquery('SELECT max(' .$fts->{COLUMN_NAME} .') FROM ' .$tbc)->fetchrow_arrayref();
$vts =$vts && $vts->[0];
my $cts =0;
if ($vts) {
my $sql ='SELECT count(*) FROM ' .$tbc .' WHERE ' .$s->{-dbi}->quote_identifier($fts->{COLUMN_NAME}) .'=' .$s->{-dbi}->quote($vts);
$cts =$s->dbiquery($sql)->fetchrow_arrayref();
$cts =$cts && $cts->[0] ||0;
print "$sql --> $cts;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
if (!$cts) {
}
elsif (0 && ($cts > $arg{-lim_rf})) {
$cts -=1;
}
elsif ($cts >= $arg{-lim_rf} *2) {
$cts -=$arg{-lim_rf};
$arg{-lim_rf} *=2;
}
elsif ($cts >= $arg{-lim_rf}) {
lib/ARSObject.pm view on Meta::CPAN
}
$vts =$s->timestr($vts) if $vts =~/\s/;
$vts =$s->timestr($vts) if $vts =~/^(.+)\.0+$/;
}
if ($s->{'-meta-sql'}->{$tbl}->{-cols}->{_arsobject_insert}
&& (!exists($arg{-ckpush}) ||$arg{-ckpush})) {
local $s->{-strFields} =0;
my $sql ='SELECT * FROM ' .$tbc
.' WHERE _arsobject_insert=1 OR _arsobject_update=1 OR _arsobject_delete=1'
.' ORDER BY ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' asc';
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
my $dbq =$s->dbiquery($sql);
my ($rd, @rq) =({});
while (($rd && ($rd =$dbq->fetchrow_hashref())) ||scalar(@rq)) {
if ($rd) {
push @rq, $rd;
next if scalar(@rq) <$arg{-lim_or};
}
else {
next if !scalar(@rq)
}
lib/ARSObject.pm view on Meta::CPAN
|| !exists($rd->{$f->{COLUMN_NAME}})
|| !$f->{fieldId}
|| $f->{IS_JOINED} ||$f->{DISPLAY_ONLY}
|| $f->{IS_PK}
|| (($f->{fieldId}||'') =~/^(1|2|3|5|6|15|179)$/);
$rd->{$f->{COLUMN_NAME}} =$1
if defined($rd->{$f->{COLUMN_NAME}})
&& ($f->{TYPE_NAME} =~/^(?:datetime|float)$/)
&& ($rd->{$f->{COLUMN_NAME}}=~/^(.+)\.0+$/);
$rd->{$f->{COLUMN_NAME}} =defined($ra->{$f->{fieldName}}) && ($ra->{$f->{fieldName}} =~/\.(\d+)$/)
? sprintf('%.' .length($1) .'f', $rd->{$f->{COLUMN_NAME}})
: $rd->{$f->{COLUMN_NAME}} =~/^(.+)\.0+$/
? $1
: $rd->{$f->{COLUMN_NAME}}
if $ra
&& ($f->{TYPE_NAME} eq 'float')
&& defined($rd->{$f->{COLUMN_NAME}});
$rw->{$f->{fieldName}} =!defined($rd->{$f->{COLUMN_NAME}})
? $rd->{$f->{COLUMN_NAME}}
: $f->{TYPE_NAME} eq 'datetime'
? timestr($s, $rd->{$f->{COLUMN_NAME}})
lib/ARSObject.pm view on Meta::CPAN
}
my $sql = $rd->{_arsobject_insert} || $rd->{_arsobject_delete}
? ('DELETE FROM ' .$tbc
.' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rd->{$fpk->{COLUMN_NAME}}))
: ('UPDATE ' .$tbc .' SET '
.join(', ', map { !exists($rd->{$_})
? ()
: ($s->{-dbi}->quote_identifier($_) .' =NULL')
} '_arsobject_insert','_arsobject_update', '_arsobject_delete')
.' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rd->{$fpk->{COLUMN_NAME}}));
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
$s->{-dbi}->do($sql)
|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
}
@rq =();
}
}
if ($arg{-ckdel}) {
my $cnl ='';
my $dbr =[];
while ($dbr) {
my $sql ='SELECT ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME})
.' FROM ' .$tbc
.($cnl ||$s->{'-meta-sql'}->{$tbl}->{-cols}->{_arsobject_insert}
? ' WHERE ' .join(' AND ', map {$_ ? "($_)" : ()
} ($s->{'-meta-sql'}->{$tbl}->{-cols}->{_arsobject_insert} ? '_arsobject_insert IS NULL OR _arsobject_insert=0' : '')
, ($cnl ? $s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .'<=' .$s->{-dbi}->quote($cnl) : ''))
: '')
.' ORDER BY 1 desc';
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
my $dbq =$s->dbiquery($sql);
my @cnd;
my @rms;
while (($dbr && ($dbr =$dbq->fetchrow_arrayref())) ||scalar(@cnd)) {
if ($dbr) {
push @cnd, $dbr->[0] =~/^([^\s]+)/i ? $1 : $dbr->[0];
}
if ($dbr ? scalar(@cnd) >=$arg{-lim_or} : scalar(@cnd)) {
my %ars =map { ($_->{$fpk->{fieldName}} => 1)
} $s->query(-form=>$arg{-form}
lib/ARSObject.pm view on Meta::CPAN
}
@cnd =();
sleep($arg{-sleep} ||0);
if (scalar(@del)) {
$dbq->finish();
last;
}
}
}
foreach $sql (@rms) {
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
$@ ='Unknown error';
$s->{-dbi}->do($sql)
|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
}
}
}
if (!exists($arg{-ckupd}) || $arg{-ckupd}) {
my $sqlm=0;
local $s->{-strFields} =0;
my $fpksql ='SELECT * FROM ' .$tbc .' WHERE ' .$fpk->{COLUMN_NAME} .'=';
lib/ARSObject.pm view on Meta::CPAN
}
}
my $sql ='SELECT max(d.' .$s->{-dbi}->quote_identifier($fts->{COLUMN_NAME}) .')'
.', max(m.' .$s->{-dbi}->quote_identifier($mts) .')'
.' FROM '
.join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $mtb)
." m, $tbc d"
.' WHERE m.' .$s->{-dbi}->quote_identifier($mpk)
.'=d.' .$s->{-dbi}->quote_identifier($mfk);
my $mtv = $s->dbiquery($sql)->fetchrow_arrayref();
print "$sql --> " .($mtv ? join(', ', map {$s->{-dbi}->quote(defined($_) ? $_ : 'undef')} @$mtv) : "'undef'") .";\n"
if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
$mtv =!$mtv ||!$mtv->[0] ||!$mtv->[1]
? ''
: $mtv->[0] lt $mtv->[1]
? $mtv->[0]
: $mtv->[1];
$sql ='SELECT count(*) FROM '
.join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $mtb)
.' WHERE '
.$s->{-dbi}->quote_identifier($mts) .'=' .$s->{-dbi}->quote($mtv);
lib/ARSObject.pm view on Meta::CPAN
? $s->dbiquery('SELECT max(m.' .$s->{-dbi}->quote_identifier($mpk) .'), count(*)'
.' FROM '
.join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $mtb)
." m, $tbc d"
.' WHERE m.' .$s->{-dbi}->quote_identifier($mpk)
.'=d.' .$s->{-dbi}->quote_identifier($mfk)
.' AND m.' .$s->{-dbi}->quote_identifier($mts) .'=' .$s->{-dbi}->quote($mtv)
)->fetchrow_arrayref()
: '';
$mpv =$mpv && $mpv->[0] ||'';
print "$sql --> $mtc;\n"
if $mpv && (exists($arg{-echo}) ? $arg{-echo} : $s->{-echo});
$sql ='SELECT ' .$s->{-dbi}->quote_identifier($mpk)
.' FROM '
.join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $mtb)
.($mtv
? ' WHERE ' .$s->{-dbi}->quote_identifier($mts)
.'>=' .$s->{-dbi}->quote($mtv)
.($mpv
? ' AND ' .$s->{-dbi}->quote_identifier($mpk)
.'>=' .$s->{-dbi}->quote($mpv)
: '')
: '')
.' ORDER BY ' .$s->{-dbi}->quote_identifier($mts) .' ASC '
.', ' .$s->{-dbi}->quote_identifier($mpk) .' ASC ';
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
$lm =$s->{-dbi}->selectcol_arrayref($sql,{'MaxRows'=>$arg{-lim_rf}});
return(&{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'selectcol_arrayref',$sql)))
if !$lm && $s->{-dbi}->errstr;
# print $s->dsquot($lm),"\n";
# die('TEST')
# -form=>'HPD:HelpDesk_AuditLogSystem'
# ,-master=>'HPD:Help Desk', -master_pk=>'Entry ID',-master_fk=>'Original Request ID', -master_ts=>'Last Modified Date'
}
my ($rw, $rd) =({});
my ($cs, $cw) =($cts,0);
while ($lm ? scalar(@$lm) : 1) {
$cw++;
foreach my $r ($s->query(-form=>$arg{-form}
,-fields=>$arg{-fields}
lib/ARSObject.pm view on Meta::CPAN
? 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};
lib/ARSObject.pm view on Meta::CPAN
.(!defined($rw->{$_->{fieldName}})
? 'NULL'
: $s->{-dbi}->quote($rw->{$_->{fieldName}})
))
} @flds)
.' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rw->{$fpk->{fieldName}});
$cu++
}
if ($sql) {
# local $s->{-dbi}->{LongTruncOk} =1;
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
$s->{-dbi}->do($sql)
|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
}
}
if (!$fts && ($cs == $cw *$arg{-lim_rf})) {
sleep($arg{-sleep} ||0);
next;
}
elsif ($lm) {
sleep($arg{-sleep} ||0);
next;
}
last;
}
if ($arg{-unused} && ($fts ? $vts : 1)) {
my $sql ='DELETE FROM ' .$tbc .' WHERE '
.dbidsqq($s
, $vts && $fts ? '(' .$fts->{COLUMN_NAME} .'<' .$s->{-dbi}->quote($s->strtime($vts||0)) .') AND (' .$arg{-unused} .')' : $arg{-unused}
, $s->{'-meta-sql'}->{$tbl});
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
my $n= $s->{-dbi}->do($sql)
|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
$cd +=$n;
}
}
join(', ', map {$_ ? $_ : ()} $ci && "new $ci", $cu && "upd $cu", $cd && "del $cd")
||'up-to-date'
}
lib/ARSObject.pm view on Meta::CPAN
: (($r ? ',' : '')
.$s->{-dbi}->quote_identifier($m->{-fields}->{$e} || $m->{-ids}->{$e} || $e)
);
$i =!$i;
}
$r})
: $arg{-order}
? ('ORDER BY ' .$arg{-order})
: '')
);
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
local $s->{-dbi}->{LongReadLen} =$s->{-dbi}->{LongReadLen} <= 1024 ? 4*64*1024 : $s->{-dbi}->{LongReadLen};
my $h =$s->dbiquery($sql);
my $xu=exists($arg{-undefs}) && !$arg{-undefs};
my $yc=$arg{-select} ||ref($arg{-fields})
|| ($arg{-fields} && ($arg{-fields} eq '*'));
my $ys=defined($arg{-strFields}) ? $arg{-strFields} : $s->{-strFields};
local $s->{-strFields} =defined($arg{-strFields}) ? $arg{-strFields} : $s->{-strFields};
my ($r, $r1, @r);
while ($r =$h->fetchrow_hashref()) {
$r1 ={map { $xu && !defined($r->{$_})
lib/ARSObject.pm view on Meta::CPAN
# MSDN: 'CreateEvent', 'Kernel Object Namespaces'
my $q =_sooncl($s, $cs, 1);
my $n =$q;
$n =~s/[\\]/!/g;
$n ="Global\\$n";
# sleep(60);
$wl =Win32::Event->new(0,0,$n);
# $s->fstore(">>$lf", $s->strtime() ."\t$$\tWin32::Event->new(0,0,$n) -> " .join(', ', $wl &&1 ||0, $^E ? ($^E +0) .".'$^E'" : ()) ."\n")
# if $lf;
if ($wl && $^E && ($^E ==183)) {
print "Already '$q', done.\n";
$s->fstore(">>$lf", "\n" .$s->strtime() ."\t$$\tAlready '$q', done.\n")
if $lf;
return(0);
}
}
_sooncln($s, $mm, $lf, $wl ? '' : $cr, $cs, 1);
}
my $r =1;
while (1) {
if (!$cr) {
lib/ARSObject.pm view on Meta::CPAN
my $cmd =$cr;
if (ref($cr) eq 'ARRAY') {
$cr->[0] =Win32::GetFullPathName($cr->[0])
if ($^O eq 'MSWin32') && ($cr->[0] !~/[\\\/]/);
$cr->[0] = $cr->[0]=~/^(.+?)[^\\\/]+$/ ? $1 .'perl.exe' : $cr->[0]
if $cr->[0] =~/\.dll$/i;
$cmd =join(' ', @$cr);
}
if ($lf) {
$cmd ="$cmd >>$lf 2>>\&1";
print(($cs ? '' : "\n") ."$cmd\n");
$s->fstore(">>$lf", ($cs ? '' : "\n") .$s->strtime() ."\t$$\t$cmd\n");
if (system($cmd) <0) {
$r =0;
print("Error $!\n");
$s->fstore(">>$lf", $s->strtime() ."\t$$\t$!\n");
}
}
else {
print(($cs ? '' : "\n") ."$cmd\n");
if (system(ref($cr) ? @$cr : $cr) <0) {
$r =0;
print("Error $!\n");
}
}
}
last if $cs || !defined($mm);
my $mmm =ref($mm) eq 'CODE' ? &$mm($s) : $mm;
print "sleep(", $mmm *60, ")...\n";
$s->fstore(">>$lf", $s->strtime() ."\t$$\tsleep(" .($mmm*60) .")...\n")
if $lf;
sleep($mmm *60);
}
if (defined($mm) && (ref($cs) ? scalar(@$cs) : $cs)) {
_sooncln($s, $mm, $lf, $cr, $cs, 0) if !$wl;
my $t1 =$s->strtime($s->timeadd(
sprintf('%.0f', time()/60) *60
, 0,0,0,0
, ref($mm) eq 'CODE' ? &$mm($s) : $mm
));
$t1 =$1 if $t1 =~/\s([^\s]+)/;
my $cmd ="at $t1 /interactive " ._sooncl($s, $cs);
print("$cmd\n");
$s->fstore(">>$lf", $s->strtime() ."\t$$\t$cmd\n")
if $lf;
if (system($cmd) <0) {
print("Error $!\n");
$s->fstore(">>$lf", $s->strtime() ."\t$$\t$!\n")
if $lf;
}
}
$r
}
sub _sooncl { # soon() command line former
lib/ARSObject.pm view on Meta::CPAN
$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`) {
next if $nc
? $l !~/\Q$qry\E/i
: $l !~/\Q$qry\E[\w\d\s]*[\r\n]*$/i;
next if $l !~/(\d+)/;
my $v =$1;
my $cmd ="at $v /d";
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
lib/ARSObject.pm view on Meta::CPAN
}
if (defined($v)
&& (defined($f1->{-vftran}) ? $f1->{-vftran} : defined($f->{-vftran}) ? $f->{-vftran} : $af->{-vftran})
&& (ref($f1->{-labels}) eq 'HASH') && !exists($f1->{-labels}->{$v})) {
foreach my $k (keys %{$f1->{-labels}}) {
next if $v ne $f1->{-labels}->{$k};
$v =$k;
$s->{-cgi}->param($f1->{-namecgi}, $v);
last;
}
print &{$s->{-fpmsg}}($s, 'Warning'
, ($af->{-namelbl} ||$af->{-namecgi})
.': '
."'" .($f1->{-namelbl}||$f1->{-namedb})
."' == ?\"$v\"?")
if $u
&& !exists($f1->{-labels}->{$v})
&& (defined($f1->{-lbtran}) && !$f1->{-lbtran})
}
}
}
lib/ARSObject.pm view on Meta::CPAN
.": "
.(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;
lib/ARSObject.pm view on Meta::CPAN
local $_ =$fv;
if (!($f->{-action} || $f->{-preact}) && $f->{-namecgi}) {
if (defined($fv)) {
if ((defined($f->{-lbtran}) ? $f->{-lbtran} : 0)
&& (ref($f->{-labels}) eq 'HASH') && !exists($f->{-labels}->{$fv})) {
foreach my $k (keys %{$f->{-labels}}) {
next if $fv ne $f->{-labels}->{$k};
$fv =$k;
last;
}
print &$cmsg($s, 'Warning'
, "'" .($f->{-namelbl} ||$f->{-namecgi} ||$f->{-namedb})
."' == ?\"$fv\"?")
if !exists($f->{-labels}->{$fv})
&& !$f->{-lbadd}
}
if ((defined($f->{-lbadd}) ? $f->{-lbadd} : 0)) {
$f->{-values} =do{use locale;
[sort {lc($f->{-labels}->{$a}) cmp lc($f->{-labels}->{$b})} keys %{$f->{-labels}}]}
if (ref($f->{-labels}) eq 'HASH')
&& !$f->{-values};
lib/ARSObject.pm view on Meta::CPAN
}
}
if (my $ev =!$aec || !$f->{-error}
? undef
: ref($f->{-error}) eq 'CODE'
? &{$f->{-error}}($s, $f, $_ =$fv, cfpvp($s, $f), $aec)
: !ref($f->{-error}) && (!defined($fv) || ($fv eq ''))
? $f->{-error}
: undef
) {
print &$cmsg($s, 'Error', "'" .$f->{-namelbl} ."' - $ev");
$err =1;
}
if (my $ev =!$f->{-warn}
? undef
: ref($f->{-warn}) eq 'CODE'
? &{$f->{-warn}}($s, $f, $_ =$fv, cfpvp($s, $f), $aec)
: !ref($f->{-warn}) && (!defined($fv) || ($fv eq ''))
? $f->{-warn}
: undef
) {
print &$cmsg($s, 'Warning', "'" .$f->{-namelbl} ."' - $ev");
}
}
return(undef)
if $err;
$act = $acf =$arv =undef;
foreach my $f (@{$s->{-fpl}}) {
next if (ref($f) ne 'HASH')
|| (exists($f->{-used}) && !$f->{-used});
next if !cfpused($s, $f);
if ($f->{-action} && ($f->{-action} !~/^\d$/) && cfpvv($s, $f)) {
$acf =1;
$act =[] if !$act;
push @$act, $f
}
if ($f->{-key} && $act && !$err) {
$arv =1;
foreach my $a (@$act) {
print &$cmsg($s, 'Executing', ($a->{-namelbl} ||$a->{-namecgi} ||'') .' ', $arv)
if $a->{-namelbl} ||$a->{-namecgi};
$arv =cfpaction($s, $a, '-action', $arv, $f);
next if $arv;
$err =$@;
last;
}
$act =undef;
if (!$arv) {
&$emsg($s, $err ||"Unknown 'cfpaction' error");
$err =1;
last;
}
}
if ($f->{-key}) {
$act =undef;
}
}
if ($acf) {
print &$cmsg($s, 'Done', $err ? ('Error', $@) : ('Success', $arv))
}
return(undef)
if $err;
return(1)
if $acf;
foreach my $f (@{$s->{-fpl}}) {
next if (ref($f) ne 'HASH')
|| (exists($f->{-used}) && !$f->{-used});
next if exists($f->{-widget}) && !defined($f->{-widget});
next if !$f->{-namecgi};
my $u =cfpused($s, $f);
next if $u && !($f->{-hidden} ||((ref($f->{-values}) eq 'ARRAY') && !scalar(@{$f->{-values}})));
print defined(cfpvp($s, $f))
? '<input type="hidden" name="' .$f->{-namecgi} .'__PV_" value="'
.$s->{-cgi}->escapeHTML(cfpvp($s, $f))
.'" />' ."\n"
: ''
, !$u
? ( defined($s->{-cgi}->param($f->{-namecgi}))
? '<input type="hidden" name="' .$f->{-namecgi} .'" value="'
.$s->{-cgi}->escapeHTML($s->{-cgi}->param($f->{-namecgi}))
.'" />' ."\n"
: '')
: defined(cfpvv($s, $f))
? '<input type="hidden" name="' .$f->{-namecgi} .'" value="'
.$s->{-cgi}->escapeHTML(cfpvv($s, $f))
.'" />' ."\n"
: '';
}
print ref($cfld0) ? &{$cfld0}($s) : $cfld0;
my $bb ='';
foreach my $f (@{$s->{-fpl}}) {
next if (ref($f) ne 'HASH')
|| (exists($f->{-used}) && !$f->{-used});
next if !cfpused($s, $f);
next if exists($f->{-widget}) && !defined($f->{-widget});
next if $f->{-hidden} ||((ref($f->{-values}) eq 'ARRAY') && !scalar(@{$f->{-values}}));
my $bf =$f->{-action} ||$f->{-preact};
if ($f->{-action} ||$f->{-preact}) {
$bb .=' ' if $bb;
lib/ARSObject.pm view on Meta::CPAN
: !$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}
? {}
: $f
, (!$f->{-widget0}
? ''
: ref($f->{-widget0}) eq 'CODE'
? &{$f->{-widget0}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
: $f->{-widget0})
. (!($f->{-action} || $f->{-preact}) && $f->{-namecgi} && defined(cfpvp($s, $f))
? '<input type="hidden" name="' .$f->{-namecgi} .'__PV_" value="'
lib/ARSObject.pm view on Meta::CPAN
)
)
. (!$f->{-widget1}
? ''
: ref($f->{-widget1}) eq 'CODE'
? &{$f->{-widget1}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
: $f->{-widget1})
);
}
if ($bb) {
print &$cfld($s, {}, $bb);
$bb ='';
}
print ref($cfld1) ? &{$cfld1}($s) : $cfld1;
$err ? undef : 1
}
lib/ARSObject.pod view on Meta::CPAN
$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(),
lib/ARSObject.pod view on Meta::CPAN
(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
Message for C<-die>, alike L<CGI::Carp|CGI/Carp>::set_message()
=item -echo
=> 0 | 1
(C<Error Processing and Echo>)
Echo printout switch.
Temporarilly may be used as an argument for specific methods.
alike C<query> and C<entryIns>.
=item -entryNo
=> entryIns()
(C<ARS methods>)
#!perl -w
use strict;
use Test;
BEGIN { plan tests => 2 + 5 + 1}
if (1) {
print "\nRequired modules:\n";
foreach my $m ('ARS', 'POSIX') {
print "use $m\t";
ok(eval("use $m; 'ok'"), 'ok');
}
}
if (1) {
print "\nOptional modules:\n";
foreach my $m ('Data::Dumper', 'Storable', 'DBI', 'CGI', 'SMTP') {
print "use $m\t";
skip(!eval("use $m; 1"), 1);
}
}
if (1) {
print "\nPackaged modules:\n";
foreach my $m ('ARSObject') {
print "use ${m}\t";
ok(eval("use ${m}; 1"), 1);
}
}
( run in 1.143 second using v1.01-cache-2.11-cpan-de7293f3b23 )