DBIx-Web
view release on metacpan or search on metacpan
lib/DBIx/Web.pm view on Meta::CPAN
# ,-w32ldap =>[[win=>ldap]] # Windows ADSI LDAP users/groups store
# ,-ldap =>''||[]||{} # LDAP constructor arguments, LDAP usage option
# ,-ldapsrv =>''||[]||{} # LDAP constructor arguments
# ,-ldapbind =>''||[]||{} # LDAP bind arguments (version => 3)
# ,-ldapsearch =>{} # LDAP search defaults and basic filter
# ,-ldapfu =>'' # LDAP users filter
# ,-ldapfg =>'' # LDAP groups filter
,-ldapattr =>['uid','cn'] # LDAP internal and external names
# ,-fswtr =>undef # File Store Writers, defaults in code
# ,-fsrdr =>undef # File Store Readers
,-w32IISdpsn =>($ENV{SERVER_SOFTWARE}||'') =~/IIS/ ? 1 : 0 # MsIIS deimpersonation
# ,-w32xcacls =>undef # Use WinNT 'xcacls' instead of 'cacls'
# ,&recXXX # DML command keywords
# -table -form || record form class
# -from -join[01]
# -data
# -key -where
# -urole -uname
# -ftext -version
# -filter -limit
# -order -keyord -group
# -save -optrec -test -sel
# DML record attributes
# -new -file -fupd -editable
# Record Manipulation Options:
# ,-dbd =>undef # default database engine
,-autocommit =>1 # autocommit database mode
# ,-limit =>undef||number # limit of selection
# ,-affect =>undef||1 # rows number to affect by DML
# ,-affected # rows number affected by DML
# ,-fetched # rows number fetched by DBL
# ,-limited # rows number limited by DBL
# ,-index =>boolean # include materialized views support
,-idsplit =>1 # split complex rec ID to table and row ID: 0 || sub{}
,-wikn => # wikiname fields possible
['name','subject']
# ,-wikq =>undef # wikiquery filter sub{} for recWikn()
# Record Access Control rooles:
,-rac =>1 # switch on
,-racAdmWtr =>'Administrators,root'
,-racAdmRdr =>'Administrators,root'
# ,-racReader =>[fieldnames] # readers fieldnames
# ,-racWriter =>[fieldnames] # writers fieldnames
# Record Version Control rooles:
# ,-rvcInsBy =>'fieldname' # field for user name record inserted by
# ,-rvcInsWhen =>'fieldname' # field for time record inserted when
# ,-rvcUpdBy =>'fieldname' # field for user name record updated by
# ,-rvcUpdWhen =>'fieldname' # field for time record updated when
# ,-rvcVerWhen =>'fieldname' # field for time version created when
# ,-rvcActPtr =>'fieldname' # field for actual record version pointer
# ,-rvcChgState=>[fld=>states] # changeble states of record
# ,-rvcCkoState=>[fld=>state ] # check-out state of record
# ,-rvcDelState=>[fld=>state ] # deleted state of record
# Record File Attachments rooles:
,-rfa =>1 # switch on
# ,-rfdName =>sub{} # 'rfdName' formula for key processing
# Record ID References
# ,-ridRef =>[] # reference fields
# Record Manipulation Triggers:
# ,-recTrim0A =>sub{} # 'recTrim' trigger before UI action
# ,-recForm =>'form'|sub{} # 'recForm' UI implementation
# ,-recForm0A =>sub{} # 'recForm' trigger before UI action
# ,-recForm0C =>sub{} # 'recForm' trigger before command
# ,-recForm0R =>sub{} # 'recForm' trigger before row
# ,-recFlim0R =>sub{} # 'recForm' limiter before row
# ,-recForm1C =>sub{} # 'recForm' trigger after command
# ,-recForm1A =>sub{} # 'recForm' trigger after UI action
# ,-recEdt0A =>sub() # 'recEdt' trigger before UI action
# ,-recEdt0R =>sub() # 'recEdt' trigger before row
# ,-recChg0R =>sub() # 'recChg' trigger before row
# ,-recChg0W =>sub() # 'recChg' trigger before write (and -recInsID)
# ,-recEdt1A =>sub() # 'recEdt' trigger after UI action
# ,-recNew =>'form'|sub{} # 'recNew' UI implementation
# ,-recNew0C =>sub{} # 'recNew' trigger before command
# ,-recNew0R =>sub{} # 'recNew' trigger before row
# ,-recNew1C =>sub{} # 'recNew' trigger after command
# ,-recIns =>'form'|sub{} # 'recIns' UI implementation
# ,-recIns0C =>sub{} # 'recIns' trigger before row command
# ,-recIns0R =>sub{} # 'recIns' trigger before row
# ,-recInsID =>sub{} # 'recIns' trigger for key generation
# ,-recIns1R =>sub{} # 'recIns' trigger after row
# ,-recIns1C =>sub{} # 'recIns' trigger after row command
# ,-recUpd =>'form'|sub{} # 'recUpd' UI implementation
# ,-recUpd0C =>sub{} # 'recUpd' trigger before command
# ,-recUpd0R =>sub{} # 'recUpd' trigger before each row
# ,-recUpd1C =>sub{} # 'recUpd' trigger after command
# ,-recDel =>'form'|sub{} # 'recDel' UI implementation
# ,-recDel0C =>sub{} # 'recDel' trigger before command
# ,-recDel0R =>sub{} # 'recDel' trigger before each row
# ,-recDel1C =>sub{} # 'recDel' trigger after command
# ,-recSel0C =>sub{} # 'recSel' trigger before command
# ,-recRead =>'form'|sub{} # 'recRead' UI implementation
# ,-recRead0C =>sub{} # 'recRead' trigger before row command
# ,-recRead0R =>sub{} # 'recRead' trigger before row command
# ,-recRead1R =>sub{} # 'recRead' trigger after row command
# ,-recRead1C =>sub{} # 'recRead' trigger after row command
# ,-recList =>'form'|sub{} # 'recList' UI implementation
,-tn =>{ # Template naming, see also 'ns' sub
'' =>''
,-guest =>'guest' # guest user name
,-guests =>'guests' # guest user group
,-users =>'users' # authenticated user default group
,-dbd =>'dbm' # defaultest data engine
,-id =>'id' # record identifier
,-key =>['id'] # record key
,-rvcInsBy =>'cuser' # user, record inserted by
,-rvcInsWhen =>'ctime' # time, record inserted when
,-rvcUpdBy =>'uuser' # user, record updated by
,-rvcUpdWhen =>'utime' # time, record updated when
,-rvcVerWhen =>'vtime' # time, version created when
# 'auser' # actor user
# 'arole' # actor roles
lib/DBIx/Web.pm view on Meta::CPAN
) .')'
: ref($a->{-data}) eq 'ARRAY'
? '(' .join(' OR '
, map { (!ref($_)
?($_ =~/\./ ? $_ : "$f.$_")
: ref($_) ne 'HASH'
? $_->[1]
: (defined($_->{-expr})
? $_->{-expr}
: $_->{-fld} =~/\./
? $_->{-fld}
: ($f .'.' .$_->{-fld})
))
. ' LIKE '
.$v
} grep {$_
&& ((ref($_) ne 'HASH')
|| ($_->{-fld}
&& (!$_->{-expr}
||($_->{-expr} !~/[-+*\/!|&%\s()]/))))
} @{$a->{-data}}
, $s->{-table}->{$f}->{-ftext}
? map { ($_ =~/\./ ? $_ : "$f.$_")
.' LIKE '
.$v
} @{$s->{-table}->{$f}->{-ftext}}
: ()
) .')'
: '')
}
sub dbiWSur { # User role condition substitution
my($s, $f, $r, $u) =@_;
return(dbiACLike($s, 0, $f, undef
, mdeRole($s, $f, $r)
,($u
? $s->ugnames($u)
: $s->ugnames())
, $_[4])
, $r =~/^(?:manager|principal|user)$/i
? dbiACLike($s, 0, $f, 'NOT'
, mdeRole($s, $f, 'actor')
,($u
? $s->ugnames($u)
: $s->ugnames())
, $_[4])
: $r =~/^(?:managers|principals|users)$/i
? dbiACLike($s, 0, $f, 'NOT'
, mdeRole($s, $f, 'actors')
,($u
? $s->ugnames($u)
: $s->ugnames())
, $_[4])
: ())
}
sub dbiSel { # Select records from database
# -select =>ALL, DISTINCT, DISTINCTROW, STRAIGHT_JOIN, HIGH_PRIORITY, SQL_SMALL_RESULT
# -data =>[fields] | [field, [field=>alias], {-fld=>alias, -expr=>formula,..}]
# -table =>[tables] | [[table=>alias], [table=>alias,join]]
# -join[01] =>string
# -join =>string
# -join2 =>string
# -key =>{field=>value}
# -where =>string | [strings]
# -ftext =>string
# -version =>0|1
# -order =>string | [field, [field=>order]]
# -keyord =>-(a|f|d|b)(all|eq|ge|gt|le|lt)
# -group =>string | [field, [field=>order]]
# -filter =>sub{}(cursor, undef, {field=>value,...})
my ($s, $a) =@_;
my $t =$a->{-table};
my $f =ref($t) ? $t->[0] : $t; $f =$1 if $f=~/^([^\s]+)/;
my @c;
my $r;
if (($s->{-table}->{$f}->{-dbd} ||$s->{-dbd} ||$s->{-tn}->{-dbd}) eq 'dbi') {
# local $s->{-dbiph} =1 if !exists($s->{-dbiph});
my @cn =!$a->{-key} ? ()
: $s->{-dbiph} ? sort keys %{$a->{-key}}
: keys %{$a->{-key}};
my @cv =!$a->{-key} ? ()
: $s->{-dbiph} ? map {ref($a->{-key}->{$_})
? grep {!ref($_)} @{$a->{-key}->{$_}}
: $a->{-key}->{$_}} @cn
: ();
my $kn =$s->{-table}->{$f} && $s->{-table}->{$f}->{-key} ||[];
my $tf =$s->{-table}->{$f} && $s->{-table}->{$f}->{-mdefld};
my $cf =$a->{-filter};
@c =('SELECT '
. ($a->{-select} ? $a->{-select} .' ' : '')
. (!$a->{-data} ? ' * ' # Data
: !ref($a->{-data}) ? ' ' .$a->{-data} .' '
: ref($a->{-data}) ne 'ARRAY' ? ' * '
: join(', '
, map { my $v =ref($_) && $_ || $tf && $tf->{$_} || $_;
!ref($v)
? ($v =~/\./
? $v
: "$f.$v AS $v")
: ref($v) ne 'HASH'
? join(' AS ', @$v[0..1])
: (defined($v->{-expr})
? $v->{-expr} .' AS ' .$v->{-fld}
: $v->{-fld} =~/\./
? $v->{-fld}
: ($f .'.' .$v->{-fld} .' AS ' .$v->{-fld})
)
} @{$a->{-data}}))
. ' FROM ' # From
. ( $a->{-join0} ? $a->{-join0} .' ' : '')
. (ref($t)
? join(' '
, (map {!ref($_)
? ($_,',')
: (@$_, $_->[$#_] =~/(JOIN|,)$/i
? ()
: ',')} @$t)[0..-1])
: dbiTblExpr($s, $t)
lib/DBIx/Web.pm view on Meta::CPAN
? &{$q->{-qjoin}}($s, $n, $m, $c)
: $q->{-qjoin}));
$c->{-qkey} = defined($c->{-qkey})
? $c->{-qkey}
: ref($q->{-qkey}) eq 'CODE'
? &{$q->{-qkey}}($s, $n, $m, $c)
: ref($q->{-qkey})
? {%{$q->{-qkey}}}
: $q->{-qkey};
$c->{-qwhere} = defined($c->{-qwhere})
? $c->{-qwhere}
: ($q &&( ref($q->{-qwhere}) eq 'CODE'
? &{$q->{-qwhere}}($s, $n, $m, $c)
: $q->{-qwhere}));
$c->{-qurole} = defined($c->{-qurole})
? $c->{-qurole}
: $q->{-urole};
$c->{-quname} = defined($c->{-quname})
? $c->{-quname}
: $c->{-qurole}
? $q->{-uname}
: '';
$c->{-qftext} = defined($c->{-qftext})
? $c->{-qftext}
: $q->{-ftext};
$c->{-frmLso} = defined($c->{-frmLso})
? $c->{-frmLso}
: ref($q->{-frmLso}) eq 'CODE'
? &{$q->{-frmLso}}($s,$n,$m,$c)
: ref($q->{-frmLso})
? [grep {my $v =$_;
$s->uguest()
? !grep /^$v$/, $s->mdeRoles(0)
: 1
} @{$q->{-frmLso}}]
: $s->uguest() && $q->{-frmLso}
&& do { my $v =$q->{-frmLso};
grep /\Q$v\E/, $s->mdeRoles(0)}
? undef
: $c->{-qurole} && !$s->uguest() && !$c->{-quname}
? $c->{-qurole}
: $q->{-frmLso};
$c->{-frmLsc} = defined($c->{-frmLsc})
? $c->{-frmLsc}
: ref($q->{-frmLsc}) eq 'CODE'
? &{$q->{-frmLsc}}($s,$n,$m)
: ref($q->{-frmLsc})
? [@{$q->{-frmLsc}}]
: $q->{-frmLsc};
foreach my $k (qw(-qjoin -qkey -qwhere -qurole -quname -qftext -frmLso -frmLsc)) {
delete $c->{$k} if !defined($c->{$k});
}
}
$s
}
sub cgiQInherit { # Inherit cgi query attributes if needed
my($s, $q, $qm, $tm) =@_; # (self, query, meta, table meta, table query)
# use local @$q{qw(-meta -field -data -display -order -keyord)} =@$q{qw(-meta -field -data -display -order -keyord)};
# meta - process -query specification - fill inheritance for formulas
# !meta - process request formed - fill metadata for cgiList
$tm = !$q->{-table}
? $tm
: !ref($q->{-table}) && ($q->{-table} =~/^([^\s]+)/)
? $_[0]->{-form}->{$1} || $_[0]->mdeTable($1)
: ref($q->{-table}->[0])
? $_[0]->mdeTable($q->{-table}->[0]->[0])
: ($q->{-table}->[0] =~/^([^\s]+)/) && $_[0]->mdeTable($1)
if !$tm;
# return(&{$s->{-die}}("cgiQInherit -> no table meta" .$s->{-ermd})) if !$tm;
$q->{-meta} =
(ref($q->{-meta}) && $q->{-meta})
|| ($q->{-meta} && ($_[0]->{-form}->{$q->{-meta}} || $_[0]->mdeTable($q->{-meta})))
|| $tm
if !$qm;
my $qmv =$qm ||$q->{-meta};
# return(&{$s->{-die}}("cgiQInherit -> no query meta" .$s->{-ermd})) if !$qmv;
if ($qm) {
foreach my $n (qw(-data -display -order)) {
next if !ref($q->{$n});
$q->{$n} =[@{$q->{$n}}];
}
}
foreach my $m ($q, $qmv, ($qmv ne $tm) ? $tm : ()) {
next if !$m;
if (!$q->{-data}) {
$q->{-field}=$m->{-field}
if !$q->{-field};
$q->{-data} =
($m->{-data} && [@{$m->{-data}}])
|| ($m->{-query} && $m->{-query}->{-data} && [@{$m->{-query}->{-data}}])
|| ($m->{-field}
&& [grep {(ref($_) eq 'HASH')
&& $_->{-fld}
&& ( (($_->{-flg}||'') =~/[akwqlf]/)
||(!defined($_->{-flg})
&& (ref($_->{-inp}) ne 'HASH'
? 1
: !( $_->{-inp}->{-rows}
||$_->{-inp}->{-arows}
||$_->{-inp}->{-hrefs}
||$_->{-inp}->{-rfd}))
)
)
} @{$m->{-field}}])
if !$q->{-data};
delete $q->{-data}
if !$q->{-data} || !@{$q->{-data}};
$q->{-display}=
($m->{-display} && [@{$m->{-display}}])
|| ($m->{-query} && $m->{-query}->{-display} && [@{$m->{-query}->{-display}}])
|| ($q->{-data}
&& [map { (ref($_) ne 'HASH')
|| (($_->{-flg}||'') !~/[al]/i)
|| !$_->{-fld}
? ()
: $_->{-fld}
} @{$q->{-data}}])
if !$q->{-display};
delete $q->{-display}
( run in 0.979 second using v1.01-cache-2.11-cpan-140bd7fdf52 )