DBIx-Web
view release on metacpan or search on metacpan
examples/cgi-bin/cmdb-start.psp view on Meta::CPAN
<script> # cmdb.cgi ext rpt: Start Page
# Page Header
my $s =$_; exit(0) if !$s;
my $form =$s->{-pcmd}->{-form} ||'';
my $class ="Form $form List ${form}__List ListTable";
local $s->{-htmlstart} =$s->{-htmlstart};
$s->{-htmlstart} ={} if !$s->{-htmlstart};
# $s->{-htmlstart}->{background} ='/icons/small/rainbow.gif';
$s->output($s->htmlStart() # HTTP/HTML/Form headers
,$s->htmlHidden() # common hidden fields
,$s->htmlMenu() # Menu bar
);
# form url target: _self : _blank:
$s->htmlOnLoad("{var e=document.getElementsByTagName('BASE'); if(e && e[0] && (self.name.match(/^(?:TOP|BOTTOM)\$/) || document.getElementsByName('_frame').length)){e[0].target='_blank'}}");
# list url onclick="<<$jecl>>", +_self: top>_self, bottom>top:
my $jecl ="this.target = self.name=='TOP' ? '_self' : self.name=='BOTTOM' ? 'TOP' : '_self'; return(true)";
my $jecf ="if (self.name.match(/^(?:TOP|BOTTOM)\$/) || document.getElementsByName('_frame').length) {this.target='_blank'}; return(true)";
my $utfn =$s->{-pcmd}->{-frame} ? ";_frame=BOTTOM" : '';
my $ntlm =$s->uguest() ? '' : '/ntlm';
my $ih =$s->cgiQuery('hdesk'
,{-table=>'hdesk'
# 2013-10-28 new -PlainGroupFile/-PlainUserFile
# 2013-10-22 syntax corrections:
# $#{@$v} -> $#$v ; $#{@$u} -> $#$u
# if ($^O ne 'MSWin32') -> if (0 && ($^O ne 'MSWin32')) {CORE::glob(@_)
# Win32::LoginName -> Win32::LoginName()
# 2013-08-23 corrected ugf_w32ldap(); improved ugf_w32()
# 2012-09-21 corrected udisp(), udispq()
# 2009-06-09 htmlMenu() changed: 'recNew' moved towards 'RecEdit', before 'recIns' and 'recDel'.
# 2009-06-09 misc corrections & improvements
# 2009-05-25 starting 0.80 version
# 2009-05-03 htmlStart() changed, conditional -expires=>'now'
# 2009-04-30 corrected cgiAction() switching to recKey() for 'recRead' and '-edit'
# 2009-04-02 changed -frmLsc in cgiQuery() to accept unmentioned fieldnames
# 2009-04-02 new -ovw option of htmlMQH()
# 2009-03-03 recWikn() may get table name as '-wikq'
# 2009-03-03 recWikn() corrected for deleted records
# 2009-03-02 cgiForm() corrected field hyperlink -form array with -version =>'-'
# 2009-03-02 cgiForm() extended field hyperlink -form array with -wikn field name
# 2008-11-09 new htmlSubmitSpl(): '…'
# 2008-11-09 not needed '—', 'Χ'
# 2008-11-09 PLEX 'DisableImpersonate': w32ufswtr() for tvdFTQuery() # w32IISdpsn()
# 2008-11-09 w32umail() slow - replace with umail()
# 2008-11-07 code inspection - recurse refs in 'sub{'/'sub {'
# 2008-11-05 constructor changed reusing object: new(class, self,-opt=>val)
# 2008-11-02 end() and DESTROY() edited
# 2008-11-02 ugfile() changed using Win32::Process::Create()
# 2008-10-30 cmdb: solutions association within tfvReferences()
# 2008-10-27 tfvReferences() changed: splicekeys() used; opts considered in hyperlink
# 2008-10-06 htmlMenu(): 'recNew' excluded when record editing
# 2008-10-05 htmlStart(): -target=>'_blank' for $s->cgiHook('recFormRWQ') && $s->{-pcmd}->{-edit}
# 2008-10-04 recWikn(): new '-wikq'
# 2008-10-04 cgiDDLB($self,{field},'eqp' mode,{record}) became as documented, was cgiDDLB($s, $f, $em, $qm, $d)
# 2008-10-04 new w32ufswtr()
# 2008-10-03 cmdb: corrected '*subject' hyperlink
# 2008-10-03 cmdb: rename 'Process' -> 'Operation'; does not filled by default
# 2008-10-03 cmdb: classifier 'cmdbm'+'definition' options commented for 'Application', 'Location', 'Operation'
# 2008-10-03 cmdb: new 'definition' record type
# 2008-09-30 osCmd() corrections for 'xcacls','cacls', !win32
# 2008-09-30 osCmd('cacls') may buzz sometimes somewhy - 'xcacls' may be used
# 2008-03-25 changed udispq() using $CACHE
# 2008-03-20 'Managers' -> 'Manager'; replace -frmLso with -urole
# 2008-03-20 chg cmdb.cgi: adding new -frmLso=>'Nowdays', deleting 'Today'
# 2008-03-20 chg cmdb.cgi: replace -frmLso with -urole
# 2008-03-20 chg cgiQuery(): new my $qq =$c->{-qwhere} && (($c->{-qwhere} =~/^(\[\[.*?\]\])/) || ($c->{-qwhere} =~/^(\/\*.*?\*\/)/)) && $1;
# 2008-03-20 chg cgiParse(): split 'frmLso' if ','
# 2008-03-17 testing htmlML() for _frmName.disabled
# 2008-03-17 improved htmlMB('back') for Mozilla
# 2008-03-17 corrected htmlML() switching on frameset
# 2008-03-17 new $LNG->{-die} and $LNG->{-warn} fixing \&CORE::die and \&CORE::warn undefined subroutine behaviour
# 2008-03-04 cgiHelp/htmlMenu/cgiParse improved
# 2008-03-03 starting 0.74 version
# 2008-02-29 extnd -help using html
# 2008-02-20 chgd cgiRun(), htmlML() restoring '_frame' lost needed for Mozilla
# 2008-02-20 chgd htmlML(), cgiParse() name postfixes: [+&.] -> [+&.^]
# htmlML(): _frmName.value.match(/\\+\$/) -> (/[+^]\$/)
# htmlML(): disabled auto '++' gen under 'frmCallNew'
# htmlMChs(): disabled auto '++' gen under 'frmCallNew'
# 2008-02-19 new 'frmLsoff'
# 2008-02-19 new -dbistart, changed dbi(), dbiConnect()
# 2008-01-14 htmlMenu() changed considering '[[]]' -qwhere
# 2008-01-14 uglist('-u',groupname) corrected, may return empty [].
# uglist('-u',groupname,[]) reads users file to distinguish users from groups
# 2008-01-13 cmdb example development
# 2007-12-29 cgiSel() correction: empty '[[]]' exam: /^\[\[(.*?)\]\]/ instead of /^\[\[(.+?)\]\]/
# 2007-12-27 starting 0.73 version
# 2007-12-21 *fatalsToBrowser -> *fatalsToBrowser{CODE} - globbing variables, perlref, perlmod
# 2007-12-18 set() error handler redesign using values of ($SIG{__DIE__}, $SIG{__WARN__})
# 2007-12-18 set() error handler redesign using $SELF ||$DB::args[0]; instead of $s
# 2007-12-18 cgiRun() error handler redesign using $SIG{__DIE__} =\&CGI::Carp::die;
# 2007-12-18 PerlEx: -serial=>0 to prevent locking buzz
# 2007-06-13 corrected -serial: start(), varLoad(), varLock(), update operation
# 2007-06-10 for perl58: use CGI qw(-no_xhtml);... start_html(-encoding=>charset)
# 2007-06-03 publishing 0.68 version
# 2007-06-03 cmdb-e: start page view
# 2007-05-22 new htfrDiff(), changed htmlField()
# 2007-05-17 htmlML() corrected for frameset switching
# 2007-05-17 '_qurole' ddlb fix in cgiParse(), cgiForm(), cgiDDLB()
# 2007-05-07 cmdb: service graph view, notes table
# 2007-05-07 cgiRun() fixed assigning -form for -cgcCall
# 2007-05-07 htmlML() implemented _frmName revert when submit
# 2007-05-07 '-menuchs' item may be scalar, changed htmlML(), htmlMenu(), tvdIndex()
# 2007-05-04 psEval() fixed
# 2007-05-02 htmlHidden(), htmlMenu() fixed to use object name & meta form -pcmd
# 2007-04-28 cmdb-s: oTk users
# 2007-04-27 cmdb: a_hdesk_stbar() extended with totals by 'severity'
# 2007-04-27 new '-ugflt1'
# 2007-04-27 cmdb: added groupings of objects, applications, processes...
# 2007-04-26 cmdb: new 'cause' field
# 2007-04-26 fixed htmlRFD(): '%' translation in <a href="...$/..%252B..."
# 2007-04-26 cmdb: new 'rollback' status
# 2007-04-25 cgiList() '-lsthtml' not escaped for XML too
# 2007-04-25 cmdb: unavailability color
# 2007-04-24 cmdb: instruction finder for 'subject'
# 2007-02-28 itroducing -qjoin/-join2
# 2007-02-28 cmdb.cgi - fix final datetime greater now
# 2007-02-28 cmdb.cgi - fix priority inheritance
# 2007-02-28 cmdb.cgi - 'vsubjectx', 'tvfReferences'
# 2007-02-28 fixed xmlEscape(), xmlTagEscape() to $v =~s/([\\"<>])/sprintf('\\x%02x',ord($1))/ge;
# 2007-02-28 fixed cgiList() XML to &{$_->[1]}($s, $cargo, undef, $i, $r)
# 2007-02-08 fixing frames: tvdIndex, htmlMB including separate -OnClick and -href
# 2007-02-07 fixing frames: htmlMQH, cgiRun including _frame considering non-MSIE
# 2007-02-06 fixing: remove _frame name from URLs, wrong open in new window
# changes:
#+ htmlMenu: + local $c->{-frame} =undef;
#+ htmlMB: + ||document.getElementsByName('_frame').length
#+ htmlMQH: + && ($s->{-pcmd}->{-frame} !~/^(?:TOP|BOTTOM)$/)
#+ htmlML + (self.name=='TOP') || document.getElementsByName('_frame').length
#+ htmlEnd + conditional base.target
#+ tvdIndex + self/self, self/new; excuded top/new
#+ cgiRun - off _frame
# frame, _frame, -frame: ('i'gnoring, 'c'hanging):
#i smtpSend # undef
#c cgiRun: # Frameset creation
#c htmlStart (-target=>$s->{-pcmd}->{-frame}) || (-target=>'_self')
#i htmlHidden # hidden field
#c htmlMenu !$c->{-frame} || ($c->{-frame} =~/^(?:top|bottom)$/i) ? '-frame=set'
#i urlOptl (& urlOpt) # may be excluded
#c htmlML js match (TOP|BOTTOM): ($_[0]->{-pcmd}->{-frame} && ($_[0]->{-pcmd}->{-cmd} eq 'recList')
# js match (TOP|BOTTOM): ($_[0]->{-pcmd}->{-frame} && ($_[0]->{-pcmd}->{-cmd} eq 'recList')
#c htmlMQH $s->{-pcmd}->{-frame} ? (-frame=>$s->{-pcmd}->{-frame})
#??? tvdIndex list: self | TOP
# new: self | new
# chg htmlEnd
#k htmlEnd e[0].target=(self.name=='BOTTOM' ?
# 2007-02-06 fixed -cgibus calculation: new cgibus() changed init(), set(), cgiRun()
# 2007-02-05 fixing -cgibus condition sub{} for key:// and wikn:// hyperlinks
# 2006-12-19 <html xmlns="http://www.w3.org/1999/xhtml" lang="ru-RU">
# 2006-12-19 <html xmlns="http://www.w3.org/1999/xhtml" lang="lang()">
# 2006-12-19 new lang() based on application's language, instead of lng() on user's
# 2006-12-16 'local' not needed for '$a->{-cmd}...' within recNew, recForm, recIns, recUpd, recDel, recSel, recRead, recHist
# 2006-12-14 cgiForm/recQBF/URL: empty only one of qw(qkey qwhere qurole)
# 2006-12-14 cgiDDLB() patched to obtain field label from form/table current
# 2006-12-13 cgiForm/recQBF: added -frmLso, -frmLsc confitions
# 2006-12-12 -qkey visited empty alike -qwhere and -qurole, changed:
# cgiParse() # delete $c->{-qkey} if !%{$c->{-qkey}};
# htmlHid() # ($_ !~/^(?:qwhere|qurole)$/))
# htmlMenu() # $c->{-qkey} ||($om->{-query} && $om->{-query}->{-qkey})
# cgiQDflt() # unless ($c->{-qkey}; $c->{-qkey} ? $c->{-qkey}
# 2006-12-12 doc -print, -mail, -hist, -xml, -ui, -cmd, -cmg, -style, -frame, -login
# 2006-12-11 provided recQBF(-qdisplay) experimental
# 2006-12-09 htmlMenu() button urls expanded: frmCall, recXML
# 2006-12-09 htmlMenu() button urls changed: recPrint, recXML, recHist
# 2006-12-09 dbmSeek() corrected for array keys
# 2006-12-09 new -rvcVerWhen, conditionally for ttoRVC() compatibility
# 2006-12-05 ui: changes display implemented
# 2006-12-05 new recHist(), strHTML(), strDiff()
# 2006-12-03 started recHist(), strHTML(), strDiff()
# 2006-11-29 new dbiConnect() with local DBI::ProxyServer autostart
# 2006-11-28 collecting all "<script for=window event=onload>" with -jswload
# 2006-11-22 new -recChg0W, immediate before 'w'rite, after -recInsID, for smtpSend()
# 2006-11-21 targeting bottom -> top frame
# 2006-11-17 targeting header, form, menu, instead of individual hyperlinks
# 2006-09-30 dbiSel() corrected -expr usage searching -ftext
# 2006-09-30 dbiACLike() changed, added 'table alias off' switch
# 2006-09-30 dbiKeyWhr() corrected -expr usage, added 'tbl alias off' switch
# 2006-09-30 development of cgi-bus remake seems done
# 2006-09-22 develop of 'webus' application
# 2006-09-22 changed tfvReferences(), added '<where></where>' starting for 'comment's
# 2006-09-22 new 'urlCGBtr' to translate -cgibus special urls
# 2006-09-22 non MSIE backwarding omission implemented + commented, 'backf' experiment removed
# 2006-09-10 removed/cleaned 'recQBFl', '-fwidth', 'appOp'
# 2006-09-10 added query hyperlinks to 'tfvVersions' and 'tfvReferences'
# 2006-09-08 new recNew(-proto), htmlMenu changed to create record via hyperlink with minimal inheritance
# 2006-09-07 new -datainc clause for -query
# 2006-09-07 cgiQInherit corrected, dbiSel/-ftext corrected
# 2006-09-02 dbiACLike() and dbiKeyWhr(), added table qualification, see $t
# 2006-09-02 changed dbiSel: added generation of default fields aliaces
# 2006-09-02 changed -flg unchanged mdeTable
# 2006-09-02 changed -flg new '-', 'f'; 'f' may be needed to add for cgiQInherit
# 2006-09-02 changed -flg cgiQInherit: 'f', !def
# 2006-09-02 changed -flg cgiForm: '-', !def
# 2006-09-02 changed -flg cgiDBData: !def ->!, [aeu]->[au]
# 2006-08-31 changed cgiQKey() paired with cgiForm() in -qkey=>{[{}]} syntax
# 2006-08-31 changed cgiQuery(), -qkey=>{[{}]} partial case excluded to cgiQKey()
# 2006-08-30 new dsdQuot()
# 2006-08-30 changed dbiSel()/dbiKeyWhr()/htmlMenu() to nest hashes within arrays recursivelly
# 2006-08-30 fixed ugnames(name) using local -userln undef
# 2006-08-24 changed htmlMQH() - added -xpar, -xkey
# 2006-08-24 fixed ugnames(username)
# 2006-08-24 changed and corrected -frmLso1C, -frmLso2C specifications
# 2006-08-24 new htmlMQH() for -frmLso1C
# 2006-08-23 added htmlMenu() 'recNew' for 'recList'
# 2006-08-23 new cgiQDflt(); 'cgiQuery', 'cgiForm' optimized; 'htmlHidden' changed
# 2006-08-15 new cgiQInherit(), called before query formulas
# 2006-08-15 new recUnion()
# 2006-08-14 changed cgiForm, cgiQuery, cgiList: local $c->{-cmdt}, $c->{-cmdf} added for formulas
# 2006-08-14 tfvReferences() fixed, 'l' flag not needed when -data/-display in table query
# 2006-08-14 changed field spec sub{$_}({self},{field},?edit,?query...) -> ({self},{field},'eqp',...)
# 2006-08-12 changed field spec sub{$_}({self},{field},?edit,?query,value) -> (...{record})
# 2006-08-12 changed -fdclass, -fdstyle, -fhclass, -fhstyle subs to sub{$_}({self},{field},?edit,?query,value)
# 2006-08-12 changed -ldclass, -ldstyle, -lsthtml subs to sub{$_}($self,, ?hyperlink,, cursor, [record])
# 2006-08-12 changed -ddlb to sub{$_}(fld,edit,query,$_=value)
# 2005-06-18 cgiParse: recQBF -qlist -> recList -form
# 2005-06-18 recSel: new -query, removed -display, -data, -field
# 2005-06-18 reoganized -qlist -> -recQBFl, it is in doubt at all
# 2005-06-18 reoganized -qform -> -recQBF
# 2005-06-16 cgiForm: new -qform form description
# 2005-06-15 rfdPath '/rfa' usage correctn
# 2005-06-14 rfdStamp considering usernames from missed local domains
# 2005-06-12 webus gwo testing
# 2005-06-12 webus gwo 'period'
# 2005-06-10 message translation into russian
# 2005-06-10 htmlMenu recNew/recIns decoration alike recEdit/recUpd
# 2005-06-10 new -labels_LL for 'popup_menu' localization within htmlField
# 2005-06-10 changed lng() and -lng, new lngslot(), lnghash()
# 2005-06-07 cgiQuery: $qo ||'-aeq'
# 2005-06-07 new -env
# 2005-06-07 lnglbl: htmlMChs
# 2005-06-06 lnglbl: tfdRFD tvmVersions tvmHistory tvmReferences tvdIndex tvdFTQuery
# 2005-06-05 lnglbl() & lngsmt(), for htmlMenu, cgiForm, cgiList
# 2005-06-03 hash item variants for -frmLso and -frmLsc
# 2005-05-31 new -frmLsc
# 2005-05-30 cgiForm field list obtain order changed; use of -mdefld
# 2005-05-30 dbiSel field descriptions obtain using -mdefld
# 2005-05-29 new -racUser
# 2005-05-27 partitioned -frmLso
# 2005-05-24 datastr/strdata changing
# 2005-05-24 new -frmLsoAdd
# 2005-05-16 new urlOpt
# 2005-05-16 new -frmLso2C
# 2005-05-14 changed htmlMenu, cgiQuery
# 2005-05-14 new -frmLso0A, -frmLso0C, -frmLso1C
# 2005-05-04 uglist(user|group)
# 2005-05-03 new -userln, -usernt
# 2005-05-02 cgibus default usergroups implementation
# 2005-05-02 local -pcmd, -pdta, -pout to consider within triggers
# 2005-05-02 reordered -recForm0C to run after command-specific trigger
# 2005-05-02 new -recChg0A, -recChg1A, removed -recForm0A, -recForm1A
# 2005-05-01 new 'recLast', problem '-recForm0A'
# 2005-04-29 new -recForm1A
# 2005-04-28 renamed -recNew0R -> -recNew0C
# 2005-04-28 removed -recRead0R, -recRead1R, -recIns0C, -recIns1C, -recTrim0C
# 2005-04-28 new -recTrim0A, -recForm0A
# 2005-04-27 renamed -recJoint1R -> -recForm1C
# 2005-04-27 renamed -recForm1R -> -recForm0C
# 2005-04-26 development -recTrim0C
# 2005-04-24 examples settings commented
# 2005-04-24 dbiLsLike -> dbiACLike, new -dbiACLike slot.
# 2005-04-21 dbiLsLike filter sub{} // field list should be good
# 2005-04-16 htmlMenu for Mozilla
# 2005-04-16 dbiLsLike postgresql rlike
# 2005-04-10 cgiQuery -frmLso: developments & corrections
# 2005-04-10 cgiQuery -frmLso: -rvcFinState, -rvcAllState
# 2005-04-09 datastr correction
# 2005-04-09 some cgiQuery -frmLso and -qfrmLso development
# 2005-04-09 principal(s) excluding actor(s)
# 2005-04-08 htmlRFD correction, -fupd record attr
# 2005-04-08 sub{} as -frmLso
# 2005-04-05 -qwhere default query condition
# 2005-04-05 check-out '-frmLso' options
lib/DBIx/Web.pm view on Meta::CPAN
if ($ermu && ($e =~/^\Q$ermu\E(.*)/)) {$e =$1}
else {$ermu =undef}
eval{$s->logRec('Die', $e)} if !$ermu;
eval{$s->recRollback()};
$s->{-c}->{-httpheader} =$s->{-c}->{-httpheader} ||"Content-type: text/html\n\n"
if *fatalsToBrowser{CODE};
eval{ $s->output($s->htmlStart());
local $s->{-pcmd}->{-cmd} ='frmErr';
local $s->{-pcmd}->{-cmg} ='frmHelp';
local $s->{-pcmd}->{-backc} =0;
$s->output($s->htmlHidden(),$s->htmlMenu());
}
if !$s->{-c}->{-htmlstart};
eval{ my $h2;
my $ermd =$s->{-ermd};
if ($e =~/\Q$ermd\E/) {
$h2 =$`;
$e =$';
}
elsif ($e =~/[\n\r]/) {
$h2 =$`;
lib/DBIx/Web.pm view on Meta::CPAN
? $s->psEval('-', $e, undef, $on, $om, $s->{-pcmd}, $s->{-pout})
: do($e);
$s->end();
return($r);
}
# Execute predefined presentation implementation
$s->output(
$s->htmlStart($s->{-pcmd}->{-form}, $om) # HTTP/HTML/Form headers
,$s->htmlHidden($s->{-pcmd}->{-form}, $om) # common hidden fields
,$s->htmlMenu($on, $om) # Menu bar
);
$s->cgiForm($on, $om, $s->{-pcmd}, $s->{-pout}) if $s->cgiHook('recFormRWQ');
$s->cgiList($on, $om, $s->{-pcmd}, $s->{-pout}) if $s->cgiHook('recList');
$s->cgiHelp($on, $om, $s->{-pcmd}, $s->{-pout}) if $s->cgiHook('frmHelp');
$s->recCommit();
$s->cgiFooter();
$s->output($s->htmlEnd());
$s->end();
cgiRunEND:
$s
lib/DBIx/Web.pm view on Meta::CPAN
,-style => {-code=>''
.".Body {font-size: 70%; font-family: Verdana, Helvetica, Arial, sans-serif; }\n"
.".Input {font-size: 100%; font-family: Verdana, Helvetica, Arial, sans-serif; }\n"
.".Form {margin-top:0px; }\n"
."td.Form {border-style: none; border-width: 0px; padding: 0px;}\n"
."th.Form {border-style: none; border-width: 0px; padding: 0px;}\n"
."table.ListTable {border-collapse: collapse; }\n"
."th.ListTable {border-style: inset; border-color: buttonface; border-width: 0px; border-bottom-width: 1px; }\n"
."td.ListTable {border-style: inset; border-color: buttonface; border-width: 0px; border-bottom-width: 1px; padding: 0px; padding-left: 2px; padding-right: 1px; padding-top: 2px;}\n"
.".ListTableFocus {background-color: buttonface;}\n"
#.".MenuArea {background-color: navy; color: white;}\n"
.".MenuButton {background-color: buttonface; color: black; text-decoration:none; font-size: 7pt}\n"
.".MenuInput {font-size: 8pt}\n"
.".htmlMQHsel {text-decoration: none; font-weight: bolder; border-style: inset;}\n"
}
,-title =>
(do{ my $v =($s->{-pcmd} && $s->{-pcmd}->{-cmd} ||'') eq 'frmHelp'
? $s->lng(0,'frmHelp')
: (eval{$om && $s->lnglbl($om)});
$v ? $v .' - ' : ''})
.($s->{-title} ||$s->cgi->server_name())
,-class => "Body $cs"
,$s->{-pcmd}->{-frame}
lib/DBIx/Web.pm view on Meta::CPAN
.'" />')
} qw(edit backc key style frame)
,($s->{-pcmd}->{-cmg} ne 'recQBF'
? qw(qkey qjoin qwhere qurole quname qversion qorder qkeyord qlimit qdisplay)
: qw(qlist))
)
) ."\n"
}
sub htmlMenu { # Screen menu bar
my ($s,$on,$om) =@_;
return('') if $s->{-pcmd}->{-xml} ||$s->{-pcmd}->{-print};
$on =$s->{-pcmd}->{-form} ||$s->{-pcmd}->{-table} ||''
if !$on;
$om =$on && $s->{-form}->{$on}||$s->mdeTable($on) if !$om;
my $ot=$om && $om->{-table} && $s->mdeTable($om->{-table}) || $om;
my $c =$s->{-pcmd};
my $a =$c->{-cmd} ||'';
my $g =$c->{-cmg} ||'';
my $e =$c->{-edit};
my $d =$s->{-pdta};
my $n =$d->{-new} ||($c->{-cmg} eq 'recNew');
my $cs=join(' '
,$s->{-c}->{-htmlclass} ? $s->htmlEscape($s->{-c}->{-htmlclass}) : ()
,'MenuArea');
local $c->{-cmdt} =$ot || $om; # table metadata
local $c->{-cmdf} =$om || $ot; # form metadata
my @r =();
if ($s->{-logo}) { # Logotype
push @r, htmlMB($s, 'logo');
}
elsif ($s->{-icons}) { # Home
push @r, htmlMB($s, $s->{-c}->{-search} ? 'schpane' : 'home');
}
if (1) { # 'back' js button
lib/DBIx/Web.pm view on Meta::CPAN
push @r, htmlML($s, 'frmName', $s->{-menuchs}
, !$c->{-frame} || ($c->{-frame} =~/^(?:TOP|BOTTOM)$/)
? '-frame=set'
: ()
) if $s->{-menuchs};
push @r, htmlML($s, 'frmLso'
, ref($om->{-frmLso}) eq 'CODE'
? &{$om->{-frmLso}}($s, $on, $om, $c, exists($c->{-frmLso}) ? $c->{-frmLso} ||'' : ())
: $om->{-frmLso}
) if $om->{-frmLso};
push @r, htmlMB($s, htmlField($s, '_qftext', lng($s,1,'-qftext'), {-asize=>5, -class=>'Input ' .$cs .' MenuInput'}, $s->{-pcmd}->{-qftext}))
if $s->{-menuchs};
push @r, htmlML($s, 'frmName1', $s->{-menuchs1})if $s->{-menuchs1};
local $c->{-frame} =undef;
push @r, htmlMB($s, 'frmCall', ['', $s->urlOptl(-cmd=>'frmCall')])
if $s->{-menuchs};
push @r, htmlMB($s, 'recXML', ['', $s->urlOptl(-cmd=>'frmCall',-xml=>1)]);
push @r, htmlMB($s, 'recQBF');
if ($s->uguest) {}
elsif ($om->{-recNew} || $om->{-recForm}
|| ($on && (grep {( !ref($_)
lib/DBIx/Web.pm view on Meta::CPAN
: $mc;
($s->{-banner}
? (do{ my $v =ref($s->{-banner}) ? &{$s->{-banner}}($s,$on,$om) : $s->{-banner};
$v
? "\n<div class=\"$cs BannerDiv\">$v</div>"
: ''
})
: '')
.(!$s->{-icons}
? "\n<div class=\"$cs MenuDiv\">" .join("\n", @r, $mi, '<br />', $mh, '<br />', $mc ? ($mc, '<br />') : ()) ."</div>\n\n"
: ("\n<div class=\"$cs MenuDiv\"><table class=\"$cs\" cellpadding=\"0\"><tr>\n"
# cellspacing=\"1px\"
# style=\"position: absolute; top: 0; left: 0;\" # scrolled up
# <br /><br />
# scrollHeight
.join("\n", @r)
."\n" .'<td class="' .$cs .' MenuCell" valign="middle"><nobr>'
. $mi .'</nobr></td></tr>'
."\n"
."</table>\n<table class=\"$cs\" cellpadding=0 cellspacing=0 width=100%>"
# margin-top: 0px; margin-bottom: 0px; padding: 0px
.'<tr><th class="' .$cs .' MenuHeader" align="left" valign="top" colspan=20>'
.$mh .'</th></tr>'
.(!$mc ? ''
: ("\n" .'<tr><td class="' .$cs .' MenuComment" align="left" valign="top" colspan=20>'
.$mc
.'</td></tr>'))
."\n</table></div>\n"
.(0 && ($s->user() =~/diags/i) ? $s->diags('-html') : '')
.(!$c->{-refresh}
? $s->htmlOnLoad('{var w=window.document.getElementsByTagName(\'table\')[' .($e ? 1 : 0) .']; if(w){w.focus()}}')
: '')
.(0 # scrollTop==0
? '<script for="window" event="onscroll">{var w=window.document.getElementsByTagName(\'table\')[0]; window.status=document.body.scrollTop; if (!w) {} else if(document.body.scrollTop >(w.height||0)){w.style.position="absolute"; w.style.top=document.b...
: '')
."\n"))
}
sub htmlMB { # CGI menu bar button
# self, command, url, back|
my $cs =($_[0]->{-c}->{-htmlclass} ? $_[0]->htmlEscape($_[0]->{-c}->{-htmlclass}) .' ' : '')
.'MenuArea MenuButton';
my $td0='<td class="' .$cs .'" valign="middle" style="border-width: thin; border-style: outset;" ';
my $tdb=($ENV{HTTP_USER_AGENT}||'') =~/MSIE/
? ' onmousedown="if(window.event.button==1){this.style.borderStyle="inset"}" onmouseup="this.style.borderStyle="outset"" onmouseout="this.style.borderStyle="outset"" onmousein="this.style.cursor="hand""'
: ' onmousedown="if(event.which==1){this.style.borderStyle="inset"}" onmouseup="this.style.borderStyle="outset"" onmouseout="this.style.borderStyle="outset""';
if (!$_[0]->{-icons}) {
if ($_[1] =~/^</) {
$_[1]
}
elsif ($_[1] eq 'logo') {
ref($_[0]->{-logo}) eq 'CODE'
lib/DBIx/Web.pm view on Meta::CPAN
."\n</nobr></td>"
}
}
sub htmlML { # CGI menu bar list
use locale; # (self, name, values, ? add values)
my $cs =join(' '
,'Input'
,$_[0]->{-c}->{-htmlclass} ? $_[0]->htmlEscape($_[0]->{-c}->{-htmlclass}) : ()
,'MenuArea');
my $i = $_[1] eq 'frmName'
? $_[0]->cgi->param('_' .$_[1])
||$_[0]->{-pcmd}->{'-' .$_[1]}
||$_[0]->{-pcmd}->{-form} ||''
: $_[1] eq 'frmLso'
? (($_[0]->{-pcmd}->{'-' .$_[1]} ||'') eq '-all'
? ''
: ($_[0]->{-pcmd}->{'-' .$_[1]} ||''))
: '';
my $li =$_[3];
my $f1 =undef;
($_[0]->{-icons}
? '<td class="' .$cs .' MenuButton" valign="middle" title="'
.$_[0]->htmlEscape(lng($_[0], 1, $_[1]))
.'" style="border-width: thin; border-style: outset;" >'
: '')
.do{$cs .=' MenuInput'; ''}
.'<select name="_' .$_[1]
.'" class="' .$cs .'" onchange="{'
.( $_[1] eq 'frmLso'
? 'if (_frmLso.value=="recQBF") {window.document.DBIx_Web._cmd.value=_frmLso.value; _frmLso.value="' .$_[0]->htmlEscape($i) .'"; window.document.DBIx_Web.submit(); return(true);} else {window.document.DBIx_Web._cmd.value="f...
: 1 && ($_[1] eq 'frmName1')
? ("var v=_frmName1.value; _frmName1.value=''; document.body.style.cursor=_frmName1.style.cursor='wait'; window.document.open('" .$_[0]->url ."?_cmd=frmCall;_frmName1=' +encodeURIComponent(v)"
.",self.name.match(/^(?:TOP|BOTTOM)\$/) || document.getElementsByName('_frame').length ? '_blank' : '_self'"
.", '', false); document.body.style.cursor=_frmName1.style.cursor='auto'; return(true);}\">")
: 1 && ($_[1] eq 'frmName')
? ('window.document.DBIx_Web._cmd.value="frmCall"; '
lib/DBIx/Web.pm view on Meta::CPAN
? ($_->[0]
, (ref($_->[1]) ? $_[0]->lnglbl($_->[1]) : $_->[1])
|| ucfirst($_[0]->lng(0, $_->[0])))
: ($_->{-val}||$_->{-lbl}, $_[0]->lnglbl($_) ||ucfirst($_[0]->lng(0, $_->{-val})));
$f1 =1 if (!$_ || !$n) && ($_[1] =~/^frmName/);
'<option '
.($i && ($n eq $i)
? do{$i =''; 'selected'}
: '')
.(($n eq '') || ($l =~/^[-]+/)
?(' class="' .$cs .' MenuInputSeparator"')
:(' class="' .$cs .'"'))
.' value="'
.htmlEscape($_[0], $n)
.'">'
.htmlEscape($_[0], $l)
.'</option>'
} $li
? (map {if (!(!ref($_) ? $_ : ref($_) eq 'ARRAY' ? $_->[0] : $_) && $li) {
my $v =$li;
$li =undef;
lib/DBIx/Web.pm view on Meta::CPAN
else {
($_)
}} @{$_[2]})
: @{$_[2]}
, !$li ? () : ref($li) eq 'ARRAY' ? @{$li} : ($li)
)
.($i eq ''
? ''
:('<option selected class="' .$cs
.(($i eq '') || ($i =~/^[-]+/)
? ' MenuSeparator'
: '')
.'" value="'
.htmlEscape($_[0], $i) .'">'
.htmlEscape($_[0]
, $_[1] =~/^frmName/
? ($_[0]->{-form} && $_[0]->{-form}->{$i} && $_[0]->lnglbl($_[0]->{-form}->{$i}))
||($_[0]->{-table} && $_[0]->{-table}->{$i} && $_[0]->lnglbl($_[0]->{-table}->{$i}))
||$_[0]->lng(0, $i)
: $_[0]->lng(0, $i))
.'</option>'))
lib/DBIx/Web.pm view on Meta::CPAN
: 0
} @{$q->{-data}});
push @{$q->{-data}}, $tm && $tm->{-mdefld}->{$e} || $e;
}
}
$q
}
sub htmlMQH { # Menu Query Hyperlink
# -label / -html
# -title, -style, -class, -target; reserved/ignored -tdstyle, -tdclass
# -qwhere, -qkey, -qurole, -quname, -qorder, -qkeyord
# -xpar=>0 | 1 | 2 | name | [list]
# -xkey=>name | [list]
# -ovw=>sub{}($s, match?, htmlMQH args, query inbound, query formed)
my $s =$_[0];
my $a =$#_ ==1 ? $_[1] : {@_[1..$#_]};
my $qf= # full inbound query to match required
$s->{-c}->{-htmbHref} ||do {$s->{-c}->{-htmbHref} =
lib/DBIx/Web.pm view on Meta::CPAN
local $a->{-href} = $s->urlCmd('', %$qw);
local $a->{-OnClick}=$s->urlCmd('', %$qw
, $s->{-pcmd}->{-frame}
? (-frame=>$s->{-pcmd}->{-frame})
: ()); # !!! Mozilla no OnLoad target
local $a->{-target}= '_self'
if !$a->{-target};
local $a->{-class} =
join(' '
,($s->{-c}->{-htmlclass} ? $s->htmlEscape($s->{-c}->{-htmlclass}) : ())
,('MenuArea MenuComment')
,($s->{-uiclass} ? ' ' .$s->{-uiclass} : ())
,($a->{-class} ? $a->{-class} : ())
,($qm
? 'htmlMQH htmlMQHsel'
: 'htmlMQH')
);
local $a->{-style} =
join('; '
,($s->{-c}->{-htmlstyle} ? $s->htmlEscape($s->{-c}->{-htmlstyle}) : ())
,($qm && 0
lib/DBIx/Web.pm view on Meta::CPAN
,-cmt =>sub{$_[0]->lng(1,'tvdIndex')}
,-cgcCall =>sub{
my $s =$_[0];
$s->{-fetched} =undef;
$s->{-affected} =undef;
local @{$s}{-menuchs, -menuchs1} =@{$s}{-menuchs, -menuchs1};
$s->htmlMChs() if !$s->{-menuchs};
$s->output($s->htmlStart(@_[1,2]) # HTTP/HTML/Form headers
,$s->htmlHidden(@_[1,2]) # common hidden fields
,!$s->{-pcmd}->{-print}
&& $s->htmlMenu(@_[1,2]) # Menu bar
,"\n<table class=\"ListTable\">\n"
);
$s->htmlOnLoad("{var e=document.getElementsByTagName('BASE'); if(e && e[0] && (self.name.match(/^(?:TOP|BOTTOM)\$/) || document.getElementsByName('_frame').length)){e[0].target='_blank'}}");
foreach my $e (($s->{-menuchs} ? @{$s->{-menuchs}} : ())
,($s->{-menuchs1}? @{$s->{-menuchs1}}: ())
) {
my ($n, $l) = ref($e) ? @$e : ($e, $e);
$l ='--- ' .$_[0]->lng(0, 'frmCallNew') .' ---' if !$n && !$l;
next if $n eq '-frame';
my ($o, $a) = $n =~/^(.+?)([+&.]+)$/ ? ($1, $2) : ($n, $n);
lib/DBIx/Web.pm view on Meta::CPAN
,-cmt =>sub{$_[0]->lng(1,'tvdFTQuery')}
,-cgcCall =>sub{
my $s =$_[0];
my $g =$s->cgi();
$s->{-fetched} =0;
$s->{-affected} =undef;
$s->{-pcmd}->{-cmd} =$s->{-pcmd}->{-cmg} ='recQBF';
$s->output($s->htmlStart(@_[1,2]) # HTTP/HTML/Form headers
,$s->htmlHidden(@_[1,2]) # common hidden fields
,!$s->{-pcmd}->{-print}
&& $s->htmlMenu(@_[1,2]) # Menu bar
,"\n"
);
$s->die('Microsoft IIS required') if ($ENV{SERVER_SOFTWARE}||'') !~/IIS/;
$s->die('Impersonation required') if (($ENV{GATEWAY_INTERFACE}||'') =~/PerlEx/i)
&& ($s->{-c}->{-RevertToSelf}
||$s->w32ufswtr());
$g->param('_qftwhere'
, defined($g->param('_qftwhere')) && ($g->param('_qftwhere') ne '')
? $g->param('_qftwhere')
: defined($g->param('_qftext')) && ($g->param('_qftext') ne '')
lib/DBIx/Web.pod view on Meta::CPAN
C<-subst>,
C<-recXXX> (C<-recNew>, C<-recForm>, C<-recIns>, C<-recUpd>, C<-recDel>, C<-recRead>, C<-recList>,...);
C<-recX#A> (C<-recTrim0A>, C<-recEdt0A>, C<-recEdt0R>, C<-recEdt1A>);
C<-httpheader>, C<-htmlstart>;
C<-banner>, C<-logo>, C<-search>, C<-login>, C<-icons>; C<-menuchs>, C<-menuchs1>, C<-frmLso>, C<-frmLsc>;
C<-cgvXXX>;
C<cgiRun>, C<cgiParse>, C<cgiQuery> (and C<cgiQueryFv>, C<cgiSel>);
C<urlAuth>, C<urlOpt>, C<htmlMQH>;
C<psParse>, C<psEval>;
C<htmlStart>, C<htmlEnd>, C<htmlHidden>, C<htmlMenu>,
C<cgiForm> (and also C<htmlField> and C<cgiDDLB>, C<htmlFVUT> and C<htmlFVUH>, C<tfvVersions>, C<tfdRFD>, C<tfvReferences>),
C<cgiList> (and C<cgiLst>),
C<cgiHelp>,
C<cgiFooter>.
See also C<Perl Script Pages>, C<Templates>.
=item UI Substitutions
lib/DBIx/Web.pod view on Meta::CPAN
=item -frmLso1C
=> not exists || sub{}(self, name, meta, command, menu comment) -> html
=item -frmLso2C
=> not exists || sub{}(self, name, meta, command) -> html
(C<Table/Form Description> - C<User Interface>)
C<htmlMenu> form query options, default provided by C<cgiQuery>
as C<-urole> C<recSel> clause.
C<-frmLso0A> trigger will be called for each C<-frmLso> value and
may be used to change C<-pcmd> emulating user defined query parameters.
C<-frmLso0C> trigger may be used to modify immediate arguments of Ñ<cgiQuery> issue.
C<-frmLso1C> and C<-frmLso2C> triggers may be used to modify
C<htmlMenu> comment and C<cgiList> first column header.
C<urlOpt> and C<htmlMQH> methods may be useful.
=item -fsrdr
=> not exists || [users names]
(C<File Store>)
File Store Readers - users names
lib/DBIx/Web.pod view on Meta::CPAN
Accepts and parses input parameters with C<cgiParse>
into C<-pcmd> and C<-pdta>.
Logins if needed (cgi redirection to C<-login>).
Determines required action, form and table using
C<-cgcXXX>, C<-subst>, C<-recXXX>, C<-table>.
If external implementation found, invokes it and returns.
Invokes action required (stores result in C<-pout>): C<Database Operation> or C<cgiQuery> or embedded implementation.
Reassigns C<-form> if found inside C<-pout>.
Determines external presentation implementation via C<-cgvXXX> and invokes it.
Or outputs http and html headers (C<htmlStart>),
hidden fields (C<htmlHidden>), menu bar (C<htmlMenu>),
record's form (C<cgiForm>) or list of records (C<cgiList>),
screen footer (C<cgiFooter>),
form and html footers.
Also implements '-reindex' (run C<recReindex>(1)) and '-setup' (run C<setup>)
service command line options, see also C<Command Line>.
Depending on particular environment configuration
C<cgiRun> may return DBIx::Web object, C<DESTROY>, false, C<die>.
It is recommended to use C<cgiRun> as the last call in the CGI script.
lib/DBIx/Web.pod view on Meta::CPAN
=item htmlHidden () -> hidden fields html string
C<User Interface>.
Generates hidden fields HTML to C<output> by C<cgiRun>
Uses C<-pcmd>.
=item htmlMenu () -> screen menu bar html string
C<User Interface>.
Generates menu bar HTML to C<output> by C<cgiRun>
Uses C<-pcmd>, C<-pdta>, C<-pout>.
=item htmlMQH (-option=>value,...) -> menu query hyperlink html
C<User Interface>.
Generates menu bar styled hyperlink HTML with query options.
lib/DBIx/Web.pod view on Meta::CPAN
=head1 VERSION
=over
=head2 2013-10-30 - Version 0.80
Corrected obsolete syntax, new C<-PlainGroupFile> and C<-PlainUserFile>,
thanks to Zhenya.
Corrected C<udisp>(), C<udispq>(), C<ugf_w32ldap>(), C<ugf_w32>().
Changed C<htmlMenu>().
Some minor corrections and improvements.
=head2 2009-05-25 - Version 0.79
Corrections in C<htmlRFD>, C<recRead>, C<cgiList>, C<cgiForm>, C<recWikn>, C<cgiAction>.
Extended C<cgiForm> processing C<-form> field hyperlink array with '-wikn', C<htmlMQH> with C<-ovw> option, C<cgiQuery> for C<-frmLsc> undescribed values, C<recWikn> for table name as C<-wikq> query parameter.
lib/DBIx/Web.pod view on Meta::CPAN
=head2 2008-11-09
New C<w32ufswtr>, C<-wikq>, C<umail>; deprecated C<w32umail>.
C<new> extended to reuse existed object.
C<cgiDDLB> corrected to comply with its specification.
Corrrections in
C<osCmd>, C<cgiDDLB>, C<recWikn>, C<htmlStart>, C<htmlMenu>, C<tfvReferences>,
C<ugfile>, C<initialize>, C<end>, C<DESTROY>.
CMDB and Service Desk example corrections and improvements.
=head2 2008-09-21 - Version 0.76
Minor corrections (C<pthMk>, C<cgiRun>).
Redesigned C<pthCp> - external copy command not used now.
lib/DBIx/Web.pod view on Meta::CPAN
=head2 2008-04-24 - Version 0.74
New C<-search>.
C<Perl Script Pages> may be also called directly by {-cmd=>frmCall, -form=>'filename.psp'},
without C<-cgcXXX>/C<-cgcURL>/C<-cgvXXX> registration.
Improved C<htmlMenu>, C<cgiParse>, C<cgiQuery>, C<cgiHelp>.
Corrected row-level access control filtering (C<dbiACLike>, C<dbmSeek>).
Corrected behaviour of exeptions.
CMDB and Service Desk example corrections and improvements.
=head2 2008-03-03 - Development Version 0.73
Misc corrections and improvements in C<cgiRun>, C<cgiSel>, C<uglist>, C<htmlMenu>, C<htmlML>.
New C<-dbistart>.
Extended C<-help> using HTML and improved C<cgiHelp>.
CMDB example improvements.
=head2 2007-12-27 - Development Version 0.72
lib/DBIx/Web.pod view on Meta::CPAN
=head2 2007-06-03 - Development Version 0.68
=head2 2007-04-20-05-22
Changed C<htmlField> for C<-hist>.
Corrected C<cgiRun> for C<-cgcCall>.
Changed C<htmlMenu> form choise list behaviour.
C<-menuchs> item may be form/table name.
Corrected C<htmlHidden>, C<htmlMenu>, C<psEval>.
New C<-ugflt1>.
Corrected C<cgiForm>, C<cgiList>, C<htmlRFD>.
C<-ddlbloop>/C<-loop> value may be sub{}.
Corrected C<timestr> and C<timeadd> considering DST.
CMDB example development.
lib/DBIx/Web.pod view on Meta::CPAN
=head2 2006-09-22 - Development Version 0.63
=head2 2006-09-08
New C<-proto> parameter for C<recNew>.
Changed C<htmlMenu> to create a new record using hyperlink
and minimum inheritance from record current.
New C<-datainc> parameter for C<-query>.
Extended SQL generated with default field aliaces and table qualifiers.
C<dbiSel> changed and corrected.
New 'f' and '-' values for C<-flg> attribute of C<-field>.
Reviewed usage of C<-flg>.
New C<dsdQuot>.
Changed C<cgiQuery>,C<dbiSel>,C<htmlMenu>,C<cgiForm>
to nest C<-qkey> hashes within arrays recursivelly:
-qkey=>{name=>value,... name=>[OR value,...{name=>AND value,...}]}
Fixed C<ugnames>(name) using "local C<-userln>=undef"
=head2 2006-08-04-24
Changed C<-frmLso1C> specification from sub{}(self, name, meta, command, option, comment),
corrected C<-frmLso2C> specifications from sub{}(self, name, meta, command, option).
New C<htmlMQH>.
Arranged C<cgiQuery>, C<cgiForm>, C<htmlHidden>, C<htmlMenu> handling
C<-qkey>, C<-qwhere>, C<-urole> as defaults for user defined query arguments,
considering also C<-uname>, C<-frmLso>, C<-frmLsc>.
Changed C<cgiQuery> - improved inheritance from table C<-query> parameters.
New C<recUnion>.
Fixed C<tfvReferences>: C<-flg>=>'l' not needed when C<-query>->{C<-data>/C<-display>}.
Changed C<-ldclass>, C<-ldstyle>, C<-lsthtml> specs from sub{$_}($self,cursor,[record]).
lib/DBIx/Web.pod view on Meta::CPAN
=head2 2004-08-28
C<w32adhi> created.
C<w32domain> corrected.
=head2 2004-06-26 - Development Version 0.53
XML presentation.
Menu listboxes behaviour improved.
'dbmSeek' string condition parser improved.
'DHTML Editing Component' used.
Temporary files dir environment variables usage reviewed.
Default query conditions display.
Some another reviews and corrections.
This should not be used yet...
=head2 2004-06-13 - Development Version 0.52
( run in 0.773 second using v1.01-cache-2.11-cpan-49f99fa48dc )