ARSObject
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
if !$s->{-meta}->{$f};
foreach my $ff (keys %{$fs->{-fields}}) {
$s->{-meta}->{$f}->{-fields}->{$ff} ={}
if !$s->{-meta}->{$f}->{-fields}->{$ff};
eval {@{$s->{-meta}->{$f}->{-fields}->{$ff}}{keys %{$fs->{-fields}->{$ff}}}
=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}});
my $fvs =[stat $s->vfname('-meta-sql')]->[9] ||0;
$fvs =0 if ($s->{-schgen} && (ref($s->{-schgen}) || ($s->{-schgen} >2)));
$fvs =0 if $fvs && ($fvs <([stat $s->vfname('-meta')]->[9]||0));
$fvs =0 if $fvs && ($fvs <([stat ($^O eq 'MSWin32' ? scalar(Win32::GetFullPathName($0)) : $0)]->[9]||0));
if (!$fvs) {
$s->vfload('-meta-sql') if $s->{-schgen} && -e $s->vfname('-meta-sql');
$s->{'-meta-sql'} ={} if !$s->{'-meta-sql'};
foreach my $f ($s->{-schema} ? @{$s->{-schema}} : sort keys %{$s->{-meta}}) {
$s->sqlname($f);
foreach my $ff (sort keys %{$s->{-meta}->{$f}->{-fields}}) {
$s->sqlname($f,$ff,1);
if ($s->{-meta}->{$f}->{-fields}->{$ff}->{dataType} eq 'enum') {
# $s->sqlname($f,'_str_' .$ff,1);
# $s->{'-meta-sql'}->{$s->sqlname($f)}->{-cols}->{$s->sqlname($f,'_str_' .$ff)}->{TYPE_NAME} ='varchar';
}
}
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;
$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};
return($s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$f}}->{-fields}->{$ff})
if $ff && !$fu
&& $s->{'-meta-sql'}
&& $s->{'-meta-sql'}->{-forms}
&& $s->{'-meta-sql'}->{-forms}->{$f}
&& $s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$f}}->{-fields}
&& $s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$f}}->{-fields}->{$ff};
my $ffh =$ff && $s->{-meta} && $s->{-meta}->{$f} && $s->{-meta}->{$f}->{-fields} && $s->{-meta}->{$f}->{-fields}->{$ff};
return($s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$f}}->{-fields}->{$s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$f}}->{-ids}->{$ffh->{fieldId}}})
if $ff && !$fu && $ffh && $ffh->{fieldId}
&& $s->{'-meta-sql'}
&& $s->{'-meta-sql'}->{-forms}
&& $s->{'-meta-sql'}->{-forms}->{$f}
&& $s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$f}}->{-ids}
&& $s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$f}}->{-ids}->{$ffh->{fieldId}};
my $tn =!$f
? $f
: $s->{-sqlntbl}
? &{$s->{-sqlntbl}($s, $f)}
: $s->{-sqlname}
? &{$s->{-sqlname}($s, $f)}
: sqlnesc($s, $f);
return($tn) if !$f ||!$tn;
$s->{'-meta-sql'} ={} if !$s->{'-meta-sql'};
$s->{'-meta-sql'}->{-forms} ={} if !$s->{'-meta-sql'}->{-forms};
while ($s->{'-meta-sql'}->{$tn} && ($s->{'-meta-sql'}->{$tn}->{formName} ne $f)) {
$tn =$s->{-sqlninc} ? &{$s->{-sqlninc}}($s, $tn) : sqlninc($s, $tn);
}
if (!$s->{'-meta-sql'}->{$tn}) {
$s->{'-meta-sql'}->{$tn} ={formName=>$f, -cols=>{}, -fields=>{}, -ids=>{}, timestamp=>time()};
$s->{'-meta-sql'}->{-forms}->{$f} =$tn;
}
elsif ($fu) {
$s->{'-meta-sql'}->{$tn}->{formName} =$f;
$s->{'-meta-sql'}->{-forms}->{$f} =$tn;
}
return($tn) if !$ff;
my $tc =!$ff
? $ff
: $ffh && $ffh->{fieldId}
&& $s->{'-meta-sql'}->{$tn}
&& $s->{'-meta-sql'}->{$tn}->{-ids} && $s->{'-meta-sql'}->{$tn}->{-ids}->{$ffh->{fieldId}}
? $s->{'-meta-sql'}->{$tn}->{-ids}->{$ffh->{fieldId}}
: $s->{-sqlncol}
? &{$s->{-sqlncol}($s, $ff)}
: $s->{-sqlname}
? &{$s->{-sqlname}($s, $ff)}
: sqlnesc($s, $ff);
return($tc) if !$tc;
while ($s->{'-meta-sql'}->{$tn}->{-cols}->{$tc} && ($s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}->{fieldName} ne $ff)) {
$tc =$s->{-sqlninc} ? &{$s->{-sqlninc}}($s, $tc) : sqlninc($s, $tc);
}
if ($fu ||!$s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}) {
my $flh =$s->{-meta}->{$f}->{-fields}->{$ff}->{limit};
my $tch ={COLUMN_NAME => $tc
, 'fieldName'=>$ff
, 'dataType' => $ffh->{dataType}
, 'timestamp'=>$s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}
&& $s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}->{'timestamp'}
|| time()
, $ffh && $ffh->{fieldId}
? ('fieldId' => $ffh->{fieldId})
: ()
, !$ffh ||!$ffh->{dataType}
? ()
: $ffh->{dataType} eq 'integer'
? (TYPE_NAME => 'int')
: $ffh->{dataType} eq 'real'
? (TYPE_NAME => 'float')
: $ffh->{dataType} eq 'decimal'
? (TYPE_NAME => $ffh->{dataType}
, $flh
? ($flh->{precision} ? (DECIMAL_DIGITS => $flh->{precision}) : ()
,$flh->{rangeHigh} ? (COLUMN_SIZE => length($flh->{rangeHigh})) : ()
)
: ()
)
: $ffh->{dataType} eq 'char'
&& (!$flh || !$flh->{maxLength} || ($flh->{maxLength} >255))
? (TYPE_NAME => 'text')
: 0 && ($ffh->{dataType} eq 'char') && $ffh->{indexUnique}
? (TYPE_NAME => 'char'
, $flh && $flh->{maxLength}
? (COLUMN_SIZE => $flh->{maxLength})
: ()
)
: $ffh->{dataType} eq 'char'
? (TYPE_NAME=>'varchar' # $ffh->{dataType}
, $flh && $flh->{maxLength}
? (COLUMN_SIZE => $flh->{maxLength})
: ()
)
: $ffh->{dataType} eq 'diary'
? (TYPE_NAME => 'text')
: $ffh->{dataType} eq 'time'
? (TYPE_NAME => 'datetime' # !'int'
#,COLUMN_SIZE=>19,DECIMAL_DIGITS=>0
)
: $ffh->{dataType} eq 'enum'
? (TYPE_NAME => 'int')
: ()
, $ffh && $ffh->{fieldId}
&& (($ffh->{fieldId} =~/^(?:1)$/) || $ffh->{indexUnique})
? (IS_PK => $ffh->{fieldId})
: ()
, $ffh && $ffh->{fieldMap}
&& $ffh->{fieldMap}->{fieldType}
&& ($ffh->{fieldMap}->{fieldType} ==2)
&& $ffh->{fieldMap}->{join}
&& (($ffh->{fieldMap}->{join}->{schemaIndex}||0) !=0)
? (IS_JOINED => ($ffh->{fieldMap}->{join}->{realId} || 1))
: ()
, !$ffh ||!$ffh->{option}
? ()
: $ffh->{option} ==1
? ()
: $ffh->{option} ==2
? (NULLABLE => 1)
: $ffh->{option} ==4
? (DISPLAY_ONLY => 1)
: ()
, $ffh && $ffh->{fieldId} && ($ffh->{fieldId} ==6)
? (IS_TIMESTAMP => 1)
: ()
};
$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
}
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{$_})
? ("$_=>" .dsquot($s, $a{$_}))
: ("$_=>" .strquot($s, $a{$_}))
} sort keys %a)
.')';
foreach my $k (%{$s->{-meta}->{$f}->{-fields}}) {
my $ff =$s->{-meta}->{$f}->{-fields}->{$k};
next if !$ff
|| exists($a{$k})
|| ((!defined($ff->{defaultVal}) || ref($ff->{defaultVal}))
&& !$s->{-metaid}->{$ff->{fieldId}}->{defaultVal});
$a{$k} =defined($s->{-metaid}->{$ff->{fieldId}}->{defaultVal})
? $s->{-metaid}->{$ff->{fieldId}}->{defaultVal}
: $ff->{defaultVal};
$a{$k} =$s->{-metaid}->{$ff->{fieldId}}->{strOut}
? &{$s->{-metaid}->{$ff->{fieldId}}->{strOut}}($s,$f,$s->{-metaid}->{$ff->{fieldId}},$_=$a{$k})
: strOut($s, $f, $ff->{fieldId},$_=$a{$k})
if $s->{-strFields};
}
if ($f eq 'HPD:Help Desk') {
if ($a{'Incident Number'} && (length($a{'Incident Number'}) ==1)) {
$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 $_;
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '') ."entryIns(-form=>'$f',"
.join(',', map {!defined($a{$_})
? "$_=>undef"
: ref($a{$_})
? ("$_=>" .dsquot($s, $a{$_}))
: ("$_=>" .strquot($s, $a{$_}))
} sort keys %a)
.')';
%a = map { my ($k, $v) =($_, $a{$_});
if ($k !~/^\d+$/) {
my $ff =schdn($s,$f,$k);
$k =$ff->{fieldId};
$v =$ff->{strIn}
? &{$ff->{strIn}}($s,$f,$ff,$_=$v)
: strIn($s,$f,$k,$v)
if $s->{-strFields};
}
($k => $v)
} keys %a;
delete $s->{-entryNo};
if ($f eq 'HPD:Help Desk') {
my $ii=schdn($s,$f,'Incident Number')->{fieldId};
$a{$ii} =$s->entryIns(-form=>'HPD:CFG Ticket Num Generator', 'DataTags'=>'za')
if length($a{$ii}) <2;
$s->{-entryNo} =$a{$ii};
$r =ARS::ars_CreateEntry($s->{-ctrl}, $f, %a)
}
else {
$r =$s->{-entryNo} =ARS::ars_CreateEntry($s->{-ctrl}, $f, %a)
}
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")
if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
delete @a{qw(-schema -form -from -into -id -echo)};
local $_;
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
."entryUpd(-form=>'$f',-id=>'$id',"
.join(',', map {!defined($a{$_})
? "$_=>undef"
: ref($a{$_})
? ("$_=>" .dsquot($s, $a{$_}))
: ("$_=>" .strquot($s, $a{$_}))
} sort keys %a)
.')';
%a = map { my ($k, $v) =($_, $a{$_});
if ($k !~/^\d+$/) {
my $ff =schdn($s,$f,$k);
$k =$ff->{fieldId};
$v =$ff->{strIn}
? &{$ff->{strIn}}($s,$f,$ff,$_=$v)
: strIn($s,$f,$k,$v)
if $s->{-strFields}
}
($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}
, {$a{-file}
? ('file'=>$a{-file}, 'size'=> -s $a{-file})
: ('buffer'=>$a{-set}, 'size'=> length($a{-set}))
}))
}
else {
my $r =ARS::ars_GetEntryBLOB($s->{-ctrl}, $f, $a{-id}
,$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
lib/ARSObject.pm view on Meta::CPAN
elsif ($cts >= $arg{-lim_rf} *2) {
$cts -=$arg{-lim_rf};
$arg{-lim_rf} *=2;
}
elsif ($cts >= $arg{-lim_rf}) {
$arg{-lim_rf} +=$cts;
$cts =0;
}
else {
$cts =0;
}
$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)
}
my $arq =join(' OR '
, map { $_->{$fpk->{COLUMN_NAME}}
&& ($_->{_arsobject_update} ||$_->{_arsobject_delete})
? "'" .$fpk->{fieldName} ."'=" .$s->arsquot($_->{$fpk->{COLUMN_NAME}})
: () } @rq);
my %ars =$arq
? map { ($_->{$fpk->{fieldName}} => $_)
} $s->query(-form=>$arg{-form}
,-fields=>$arg{-fields}
,-echo=>$arg{-echo}
,-query=>join(' AND '
, $arg{-query} ? '(' .$arg{-query} .')' : ()
, "($arq)"))
: ();
foreach my $rd (@rq) {
my $ra =$ars{$rd->{$fpk->{COLUMN_NAME}}};
my $rw ={};
foreach my $f (@flds) {
next if !$f->{fieldName} || !$f->{COLUMN_NAME} || !$f->{TYPE_NAME}
|| !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}})
: $rd->{$f->{COLUMN_NAME}};
}
if ($rd->{_arsobject_delete}) {
$rd->{_arsobject_insert} =$rd->{_arsobject_update} =undef;
next if $arg{-filter}
&& !&{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},$rw,$rd);
sleep($arg{-sleep} ||0);
$cd++;
$s->entryDel(-form=>$arg{-form}, -echo=>$arg{-echo}
,-id=>$rd->{$fid->{COLUMN_NAME}});
}
elsif ($rd->{_arsobject_update}) {
$rd->{_arsobject_insert} =$rd->{_arsobject_delete} =undef;
next if $arg{-filter}
&& !&{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},$rw,$rd);
$rw ={map { !defined($rw->{$_}) && !defined($ra->{$_})
? ()
: !defined($rw->{$_}) ||!defined($ra->{$_})
? ($_ => $rw->{$_})
: $rw->{$_} ne $ra->{$_}
? ($_ => $rw->{$_})
: ()
} keys %$rw}
if $ra;
if (scalar(%$rw)) {
sleep($arg{-sleep} ||0);
$cu++;
$s->entryUpd(-form=>$arg{-form}, -echo=>$arg{-echo}
,-id=>$rd->{$fid->{COLUMN_NAME}}
, %$rw);
}
}
elsif ($rd->{_arsobject_insert}) {
$rd->{_arsobject_update} =$rd->{_arsobject_delete} =undef;
next if $arg{-filter}
&& !&{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},$rw,$rd);
sleep($arg{-sleep} ||0);
$ci++;
$s->entryIns(-form=>$arg{-form}, -echo=>$arg{-echo}
, map {defined($rw->{$_}) ? ($_ => $rw->{$_}) : ()} keys %$rw);
}
my $sql = $rd->{_arsobject_insert} || $rd->{_arsobject_delete}
? ('DELETE FROM ' .$tbc
.' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rd->{$fpk->{COLUMN_NAME}}))
: ('UPDATE ' .$tbc .' SET '
.join(', ', map { !exists($rd->{$_})
? ()
: ($s->{-dbi}->quote_identifier($_) .' =NULL')
} '_arsobject_insert','_arsobject_update', '_arsobject_delete')
.' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rd->{$fpk->{COLUMN_NAME}}));
lib/ARSObject.pm view on Meta::CPAN
.($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}
,-echo=>$arg{-echo}
,$lm
? (-query=>join(' AND '
, $arg{-query} ? '(' .$arg{-query} .')' : ()
, '(' .join(' OR '
, map {"'" .($s->{'-meta-sql'}->{$tbl}->{-cols}->{$arg{-master_fk}} && $s->{'-meta-sql'}->{$tbl}->{-cols}->{$arg{-master_fk}}->{fieldName} || $arg{-master_fk})
."'=\"$_\""
} splice @$lm, 0, $arg{-lim_or}) .')'))
: (-query=>join(' AND ', map {$_ ? "($_)" : ()
} $arg{-query}, $fts && $vts ? "'" .$fts->{fieldName} ."'>=" .$vts : ()
) ||'1=1'
,-limit=>$arg{-lim_rf}
,-start=>$cs)
,-order=>$fts
? [$fts->{fieldName} => 'asc', $fpk->{fieldName} => 'asc']
: [$fpk->{fieldName} => 'asc']
)) {
$cs++;
next if !$r->{$fpk->{fieldName}};
my $sql ='';
$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) {
next if $arg{-filter}
&& !&{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},$rw,$rd);
$sql ='INSERT INTO ' .$tbc .' ('
.join(', '
, map { !exists($rw->{$_->{fieldName}})
|| !defined($rw->{$_->{fieldName}})
? ()
: $s->{-dbi}->quote_identifier($_->{COLUMN_NAME})
} @flds)
.') VALUES ('
.join(', '
, map { !exists($rw->{$_->{fieldName}})
|| !defined($rw->{$_->{fieldName}})
? ()
: $s->{-dbi}->quote($rw->{$_->{fieldName}})
} @flds)
.')';
$ci++;
}
elsif ($ru) {
next if (!exists($arg{-ckpush}) ||$arg{-ckpush})
&& ($rd->{'_arsobject_insert'}
|| $rd->{'_arsobject_update'}
|| $rd->{'_arsobject_delete'});
next if $arg{-filter}
&& !&{$arg{-filter}}($s,\%arg,$s->{'-meta-sql'}->{$tbl},$rw,$rd);
$sql ='UPDATE ' .$tbc .' SET '
.join(', '
,(exists($arg{-ckpush}) && !$arg{-ckpush}
&& $s->{'-meta-sql'}->{$tbl}->{-cols}->{_arsobject_insert}
? '_arsobject_insert=NULL, _arsobject_update=NULL, _arsobject_delete=NULL'
: ())
, map { !exists($rw->{$_->{fieldName}})
? ()
: ($s->{-dbi}->quote_identifier($_->{COLUMN_NAME}) .' ='
.(!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++
}
lib/ARSObject.pm view on Meta::CPAN
# $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 =~/[\\\/]([^\\\/]+)$/;
}
elsif ($_[1] eq '-absolute') {
$v =$ENV{SCRIPT_NAME}
}
return($v)
}
else {
# MSDN: "GetServerVariable (ISAPI Extensions)"
# ms-help://MS.MSDNQTR.v90.en/wcecomm5/html/wce50lrfGetServerVariableISAPIExtensions.htm
# http:// $ENV{HTTP_HOST} : $ENV{SERVER_PORT} / ($ENV{PATH_INFO} | $ENV{SCRIPT_NAME})
# + $ENV{QUERY_STRING}
my $v =($_[0]->{-cgi}||$_[0]->cgi)->url();
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}})
, $a{-labels1}
? sort {(defined($a{-labels1}->{$a}) ? $a{-labels1}->{$a} : '')
cmp (defined($a{-labels1}->{$b}) ? $a{-labels1}->{$b} : '')
} keys %{$a{-labels1}}
: ()
];
foreach my $e ('-labels0','-labels1') {
next if !$a{$e};
foreach my $k (keys %{$a{$e}}) {
$a{-labels}->{$k} =$a{$e}->{$k}
}
}
$a{-values}
};
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')
? "if (l.options.item(i).innerText !='' ? l.options.item(i).innerText.toLowerCase().indexOf(k)"
.($_[0] eq '3' ?'>=' :'==') .'0 : l.options.item(i).value.toLowerCase().indexOf(k)'
.($_[0] eq '3' ?'>=' :'==') .'0){'
: "if (l.options.item(i).text !='' ? l.options.item(i).text.toLowerCase().indexOf(k)"
.($_[0] eq '3' ?'>=' :'==') .'0 : l.options.item(i).value.toLowerCase().indexOf(k)'
.($_[0] eq '3' ?'>=' :'==') .'0){')
.'l.selectedIndex =i; break;};}};'
.($_[0] && ($_[0] ne '4')
? 'return(false);'
: $_[0] && ($_[0] eq '2')
? 'return(false);'
: '')
.'}}'};
($s->{-cgi}->param("${n}__O_")
? "<div><script for=\"$n\" event=\"onkeypress\">" .&$fs(0) ."</script>\n"
: '')
.$s->{-cgi}->textfield((map {defined($_) && defined($a{$_})
? ($_ => $a{$_})
: $a{-textfield} && $a{-textfield}->{$_} && !$s->{-cgi}->param("${n}__O_")
? ($_ => $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"
.join(''
, map { ($_ =~/^</
? $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'))
};
lib/ARSObject.pm view on Meta::CPAN
? $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="'
.$s->{-cgi}->escapeHTML(cfpvp($s, $f))
.'" />'
: ''
)
. (!ref($f->{-widget}) && exists($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'
? ( $f->{-values}
? $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}
? ''
: 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
}
( run in 1.508 second using v1.01-cache-2.11-cpan-140bd7fdf52 )