CGI-Bus
view release on metacpan or search on metacpan
lib/CGI/Bus/tm.pm view on Meta::CPAN
$rs =substr($rs,5);
$rs =($fb ? " $fb " : '') ."($rs)" .($fe ? " $fe " : '');
}
$s->{-cnd} =$rs
}
sub htmlbar { # Transaction batton bar html
my ($s, $o) =@_;
my $p =$s->parent;
my $g =$p->cgi;
my $guest =$p->uguest;
$o =($s->{-opflg} ||($guest ? 'qv' : 'a')) # a!v
if !defined($o);
my $r ='';
$s->cmd() if !$s->{-cmd};
if ($s->{-cmd} eq '-ins') {
# $s->{-cmd} ='-sel';
$s->{-cmdg} ='-sel'
}
my $vv = $s->{-vsd} &&
( $s->{-vsd}->{-npf} && $g->param($s->{-vsd}->{-npf})
|| $s->{-vsd}->{-sf} && ($g->param($s->{-vsd}->{-sf})||'') eq ($s->{-vsd}->{-sd}||''));
my $vm = $vv || !$s->{-cmde};
if ($s->{-logo}) {
$r .=$s->_htmlbare($s->{-logo} !~/<a /i
? '<a href="' .$p->surl .'">' .($s->{-logo} !~/</ ? '<img src="' .$s->{-logo} .'" alt="" border=0 title="' .$s->lng(1,'-nap') .'" />' : $s->{-logo}) .'</a>'
: $s->{-logo});
}
#if ((!$ENV{HTTP_REFERER}
# ||eval {my $rfr =lc(($ENV{HTTP_REFERER}||'') =~/^(.+?)\/([^\/]+)$/ ? $1 : $ENV{HTTP_REFERER}) ||'';
# lc(substr($s->parent->url, 0, length($rfr))) ne $rfr})
#&& $guest) {
# $r .=$s->_htmlbare(-lgn => $s->uauth->authurl);
#}
if (index($o,'<') >=0) {
$r .=$s->_htmlbare(-nap, $p->surl) if !$s->{-logo};
my $nth =$s->qurl;
my $nup =$s->qparamsw('REFERER') ||$ENV{HTTP_REFERER} ||($s->burl .'/');
$nup =$s->burl .'/' if lc(substr($nup,0,length($nth))) eq lc($nth);
# $r .=$s->_htmlbare(-nup, $nup);
$r .=$s->_htmlbare(-nth, $nth);
$r .=$g->hidden(-name=>$s->pxnme(-pxsw=>'REFERER')
,-value=>$s->param($s->pxnme(-pxsw=>'REFERER')) ||$ENV{HTTP_REFERER} ||$s->burl
,-override=>1) ."\n";
}
if ($s->{-tbarl}) {
$r .=$g->hidden(-name=>$s->pxnme(-pxsw=>'REFERER')) ."\n"
if $g->param($s->pxnme(-pxsw=>'REFERER'))
&& (ref($s->{-tbarl}) eq 'CODE');
$r .=$s->_htmlbare(ref($s->{-tbarl}) eq 'CODE'
? &{$s->{-tbarl}}($s, $g->param($s->pxnme(-pxsw=>'REFERER')))
: $s->{-tbarl});
}
if ($s->cmdg('-lst')) {
$r .=$s->_htmlbare(-bck => $p->{-iurl} && $img{-bck} ? $p->qurl : 0
,-onClick=>'{window.history.back(); return(false)}') #window.event.returnValue=false;
if !$s->{-formtgf};
$r .=$s->_htmlbare(-lgn => $s->uauth->authurl)
if $guest && $s->uauth->authurl;
$r .=$s->_htmlbare($g->popup_menu(-name=>$s->pxnme(-pxsw=>'LIST')
,-values=>$s->qlstnmes
,-labels=>$s->qlstlbls
,-default=>$s->qlst
,-onChange=> (!$p->{-iurl}
? $s->pxnme(-pxcb=>'-lst') .'.click()'
: '{' .$s->pxnme(-pxcb=>'-cmdi') .'.value="-lst"; submit(); return(false);}')
,-class=>'MenuArea MenuInput'
))
if $s->{-lists} && scalar(keys %{$s->{-lists}}) >1;
$r .=$s->_htmlbare($p->htmltextfield(-name =>$s->pxsw('FTEXT')
,-title=>$s->lng(1,'F-TEXT')
,-asize=>4
,-class=>'MenuArea MenuInput'
))
if $s->{-ftext};
$r .=$s->_htmlbare('-lst');
$r .=$s->_htmlbare('-qry') if $o =~/[aq]/;
}
else {
$s->cgi->delete($s->pxnme(-pxsw=>'FRMCOUNT')) if $s->cmd('-crt');
$r .=$s->_htmlbare('-bck'=> $p->{-iurl} && $img{-bck} ? $p->qurl : 0
,-onClick=>'{'
.($g->param($s->pxnme(-pxsw=>'FRMCOUNT'))||1 >1
? 'window.history.go(-' .($g->param($s->pxnme(-pxsw=>'FRMCOUNT'))||1 -1) .'); '
: '')
. 'window.history.back(); return(false)}')
if !$s->{-formtgf};
$r .=$s->_htmlbare(-lgn => $s->uauth->authurl)
if $guest && $s->uauth->authurl;
}
if ($s->cmdg('-qry') && $o =~/[aq]/) {
$r .=$s->_htmlbare('-lst');
$r .=$s->_htmlbare('-frm');
}
if (!$s->cmdg('-lst','-qry')) {
# $r .=$s->_htmlbare('-lsr') if !$s->{-formtgf};
$r .=$s->_htmlbare(-qry =>$s->htmlurl($s->qurl,$s->pxcb('-cmd')=>'-qry'))
if $o =~/[aq]/ && $o !~/![q]/
&& !$s->{-formtgf} && ($vm || $o =~/!v/);
local $s->{-keyval} =$s->keyval # !!! single field keys only
if $s->{-keyfld} && ($s->{-vsd} ||$s->{-fsd})
&& !$s->cmdg('-crt');
$r .=$s->_htmlbare('-prn'=>$s->htmlurl($s->qurl,$s->pxcb('-cmd')=>'-sel'
,$s->keyfld=>$s->{-keyval},
,'_tsw_MIN'=>'bhpvr'
)) if $vm && $o =~/[av]/
&& $s->{-keyval};
$r .=$s->_htmlbare('-sel') if $o =~/[aev]/ && $s->cmdg eq '-sel' && $o !~/![s]/ && !$vv && !$guest;
$r .=$s->_htmlbare('-edt') if $o =~/[av]/ && $s->cmdg eq '-sel' && $o !~/![veu]/ && $vm && !$vv && !$guest;
delete $s->{-keyval};
$r .=$s->_htmlbare('-frm') if $o =~/[aeu]/ && $s->cmdg ne '-del' && !$vm;
$r .=$s->_htmlbare('-upd') if $o =~/[aeu]/ && $o !~/![eu]/ && $s->cmdg eq '-sel' && !$vm && !$vv;
$r .=$s->_htmlbare('-ins') if $o =~/[aci]/ && $o !~/![ci]/ && $s->cmdg ne '-del' && !$vm;
$r .=$s->_htmlbare('-del') if $o =~/[ad]/ && $o !~/![d]/ && $s->cmdg eq '-sel' && !$vv;
}
if ($o =~/[aci]/ && $o !~/![ci]/ && !$s->cmdg('-qry') && !$vv) {
lib/CGI/Bus/tm.pm view on Meta::CPAN
elsif ($f->{-inp}->{-htmlopt} && $p->ishtml($v)) {
$wgp .=$v
}
elsif ($f->{-inp}->{-hrefs}) {
$wgp .='<code class="Form">' if $v =~/ {2,}/;
while ($v =~/\b([\w-]{3,7}:\/\/[^\s\t,()<>\[\]"']+[^\s\t.,;()<>\[\]"'])/) {
my $r =$1;
$v =$';
my $w =$p->htmlescape($`); $w =~s/( {2,})/' ' x length($1)/ge; $w =~s/\n/<br \/>\n/g; $w =~s/\r//g;
$wgp .=$w;
$r =~s/^(host|urlh):\/\//\//;
$r =~s/^(url|urlr):\/\//$s->url(-relative=>1)/e;
$r =~s/^(fsurl|urlf):\/\//($s->fsurl||$s->fsurf) .'\/'/e;
$wgp .=$g->a({-href=>$r, -target=>'_blank', -title=>$r, -class=>'Form'}
, $p->htmlescape(length($r) >49 ? substr($r,0,47) .'...' : $r));
}
$v =$p->htmlescape($v); $v =~s/( {2,})/' ' x length($1)/ge; $v =~s/\n/<br \/>\n/g; $v =~s/\r//g;
$wgp .=$v;
$wgp .='</code>' if $wgp =~/<code class="Form">/;
}
elsif (exists($f->{-inp}->{-arows}) ||exists($f->{-inp}->{-rows}) ||exists($f->{-inp}->{-cols})) {
$v =$p->htmlescape($v); $v =~s/( {2,})/' ' x length($1)/ge; $v =~s/\n/<br \/>\n/g; $v =~s/\r//g;
$v ="<code class=\"Form\">$v</code>" if $v =~/  /;
$wgp .=$v;
}
elsif ($f->{-inp}->{-labels}) {
my $fi =$f->{-inp};
$fi->{-labels} =&{$fi->{-labels}}($s) if ref($fi->{-labels}) eq 'CODE';
$v =$fi->{-labels}->{$v} if defined($fi->{-labels}->{$v});
$wgp .=$p->htmlescape($v)
}
elsif (ref($f->{-inp}->{-values}) eq 'HASH') {
$wgp .=$p->htmlescape(exists($f->{-inp}->{-values}->{$v}) ? $f->{-inp}->{-values}->{$v} : $v)
}
else {
$wgp .=$p->htmlescape($v)
}
}
elsif (!$f->{-inp}) {
# $wgp .=$g->textfield(-name=>$f->{-fld},-title=>$cmt)
$wgp .=$p->htmltextfield(-name=>$f->{-fld},-asize=>20,-title=>$cmt,-class=>'Form')
}
elsif (ref($f->{-inp}) eq 'HASH') {
if (exists $f->{-inp}->{-arows}) {
$f->{-inp}->{-arows} =$f->{-inp}->{-arows} ||3;
$wgp .=$p->htmltextarea(-name=>$f->{-fld},%{$f->{-inp}},-title=>$cmt,-class=>'Form')
}
elsif (exists ($f->{-inp}->{-rows}) ||exists($f->{-inp}->{-cols}) || $f->{-inp}->{-hrefs}) {
$wgp .=$p->htmltextarea(-name=>$f->{-fld},%{$f->{-inp}},-title=>$cmt, -class=>'Form')
}
elsif (exists $f->{-inp}->{-asize}) {
$f->{-inp}->{-asize} =$f->{-inp}->{-asize} ||20;
$wgp .=$p->htmltextfield(-name=>$f->{-fld},%{$f->{-inp}},-title=>$cmt,-class=>'Form')
}
elsif ($f->{-inp}->{-values} ||$f->{-inp}->{-labels}) {
my $fi =$f->{-inp};
$fi->{-values} =&{$fi->{-values}}($s) if ref($fi->{-values}) eq 'CODE';
$fi->{-labels} =&{$fi->{-labels}}($s) if ref($fi->{-labels}) eq 'CODE';
$fi->{-values} =[sort {lc($fi->{-labels}->{$a}) cmp lc($fi->{-labels}->{$b})} keys %{$fi->{-labels}}]
if !$fi->{-values};
$wgp .=$p->popup_menu(-name=>$f->{-fld},%{$f->{-inp}},-title=>$cmt,-class=>'Form')
}
else {
$wgp .=$p->htmltextfield(-name=>$f->{-fld},%{$f->{-inp}},-title=>$cmt,-class=>'Form')
}
}
elsif (ref($f->{-inp}) eq 'ARRAY') {
my $t =$f->{-inp}->[0];
my %a =$f->{-inp}->[1] ? %{$f->{-inp}->[1]} : ();
$wgp .=$s->$t(-name=>$f->{-fld},%a,-title=>$cmt)
}
if (defined($wgh)) {
$wgh =~s/\$_/$wgp/;
$wgp =$wgh;
if ($mp || ($wgp =~/< *input[^<>]*>/i)) {}
elsif ($wgp !~/<\/t[dh]\b/i) {
$wgp .=$g->hidden(-name=>$f->{-fld})
}
else {
$wgp =~s/(<\/t[dh]\b)/$g->hidden(-name=>$f->{-fld}) .$1/ie;
}
}
$wgp ='<td valign="top" align="left" class="Form"'
.($f->{-colspan} ? ' colspan=' .$f->{-colspan} :'')
.($f->{-width} && $f->{-width} =~/\D/ ? ' width=' .$f->{-width} :'')
.(!$vm ? ' title="' .$p->htmlescape($cmt||'') .'"' : '')
.'>' .$wgp .'</td>'
if !$tskip && $wgp !~/^\s*<t[dh]\b/i && !($hide && $f->{-hidel});
$p->print($wgp, "\n");
$rskip =undef;
}
$p->print("\n</tr>\n", $s->{-htmlte} ? $s->{-htmlte} : "\n</table>\n")
if !$tskip;
$s
}
sub cmdhlp { # Help Command
my $s =shift;
my $p =$s->parent;
my $g =$p->cgi;
my $o =defined($_[0]) && substr($_[0],0,1) eq '-' ? shift : '-tolfc';
# 't'itle, 'o'ther, 'l'ists, 'f'ields, 'c'ommands
my $ta={-align=>'left',-valign=>'top'};
my $sh='';
if ($o =~/t/) {
$sh ='Help';
my $t =$s->parent->{-htmlstart}->{-title}||$s->parent->{-htpgstart}->{-title}||'';
print '<div class="MenuArea"><table class="MenuArea" cellpadding=0><tr>'
, $s->{-formtgf} ? '' :$s->_htmlbare(-bck=> $p->{-iurl} && $img{-bck} ? $p->qurl : 0, -onClick=>'{window.history.back(); return(false)}')
, '</td><th valign="middle" class="MenuArea MenuHeader">'
, $s->htmlescape(($t ? "$t - " : '') .$s->lng(0, $sh))
, "</th></tr></table><hr /></div>\n";
}
if ($o =~/[fo]/ && $s->{-form}) {
$sh ='Fields';
print $g->h2($s->htmlescape($s->lng(0, $sh))),"\n";
$sh =$s->lng(1, $sh);
print $g->p($s->htmlescape($sh)),"\n" if $sh;
( run in 1.220 second using v1.01-cache-2.11-cpan-364913b4093 )