CGI-Bus

 view release on metacpan or  search on metacpan

lib/CGI/Bus/tm.pm  view on Meta::CPAN

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) {
    local $s->{-keyval} =$s->keyval	# !!! single field keys only
			if $s->{-keyfld} && ($s->{-vsd} ||$s->{-fsd});
    if (!$s->{-formtgf}) {
	$r .=$s->_htmlbare('-crt')
    }
    else {
	$r .=$s->_htmlbare('-crt'
			,$s->htmlurl($s->qurl, $s->pxcb('-cmd')=>'-crt')
			,-target=>$s->{-formtgf})
    }
 }
 if ($s->{-tbarr}) {
    $r .=$s->_htmlbare($s->{-tbarr});
 }
 if (1) {
    $r .=$s->_htmlbare('-hlp'
			,$s->htmlurl($s->qurl,$s->pxcb('-cmd')=>'-hlp')
			,-target=>$s->{-formtgf});
 }
 if (1) {
    $r .='<td class="MenuArea" valign="middle" align="right">';
    $r .='&nbsp;[' .$s->lng(0,$s->cmd) 
             .(!$s->cmdg ||$s->cmd eq $s->cmdg ?'' : ('/' .$s->lng(0,$s->cmdg)))
             .']&nbsp;';
    $r .="</td>\n"
 }
 $r  ="<div class=\"MenuArea\"><table class=\"MenuArea\" cellpadding=0><tr>\n"
	.$r ."</tr></table></div>\n"
	.($s->cmd('-lst') && ($s->{-refresh} || $s->{-lists} && $s->qlst && $s->{-lists}->{$s->qlst}->{-refresh})
	 ? ''
	 :('<script for="window" event="onload">{'
	  ."var w=window.document.getElementsByTagName('table')[0]||window.document.getElementsByTagName('table')[0];"
	  ."if(w){w.focus()}}</script>\n"));
 if ($s->{-banner}) {
	my $v =ref($s->{-banner}) ? &{$s->{-banner}}($s) : $s->{-banner};
	$r =($v ? "<div class=\"MenuArea MenuBanner\">$v</div>\n" : '') .$r;
 }
#$r .='<hr />';
 $r
}


sub _htmlbare { # Transaction batton bar element
 my ($s, $b, $u, %a) =@_;
 my $p =$s->parent;
 my $g =$p->cgi;
 my ($v, $t);
    ($v, $t) =($s->lng(0,$b), $s->lng(1,$b)) if !ref($b) && $s->lng($b);
 my $j =$a{-onClick} ||'if (window.event.srcElement.children[0]) {window.event.srcElement.children[0].click()}';
    delete $a{-onClick};
	# $a{-onclick} ||$a{-onClick} || '{window.event.srcElement.children(0).click(); return(false)}';
 my $h = ref($b) 
       ? join('</td><td valign="middle" class="MenuArea MenuButton">', @$b)
       : $u ? $g->a({-href=>$u,-title=>$t
			,-class=>'MenuArea MenuButton'
                    ,%a}
                   , $p->{-iurl} && $img{$b} 
                   ? '<img src="' .$p->{-iurl} .'/' .$img{$b} 
			.'" border=0 align="bottom" class="MenuArea MenuButton"'
			.($b eq '-lgn' ? ' width=20 height=22 />' : ' />')
			.$p->htmlescape($v)
                   : $p->htmlescape($v)) .' '
       : $v ? ( $p->{-iurl} && $img{$b}
              ? $g->image_button(-name=>$s->pxnme(-pxcb=>$b)
				,-value=>$v
				,-src=>$p->{-iurl} .'/' .$img{$b}
				,-align=>'bottom'
				,-accesskey=>substr($v,0,1)
				,-title=>$v .'. ' .$t
				,-class=>'MenuArea MenuButton'
				,-style=>'cursor: default;'
				,%a) 
			.((($b =~/^-(?:ins|upd|del|frm)/) || 
			  (!$s->{-keyval} && $b =~/^-q(?:sel|edt)/)) && 1
			?$g->span({
				 -title=>$t
				,-class=>'MenuArea MenuButton'
				,-style=>'cursor: default;'
				,-onClick=>$j='{' .$s->pxnme(-pxcb=>'-cmdi') .'.value="'.$b .'"; submit(); return(false)}'}
				,$p->htmlescape($v))
			:$g->a({href=>$s->qurl('',$s->pxnme(-pxcb=>'-cmd')=>$b, !$s->{-keyval} ? () : ($s->keyfld=>$s->{-keyval}))
				,-title=>$t
				,-class=>'MenuArea MenuButton'
				,-onClick=>$j='{' .$s->pxnme(-pxcb=>'-cmdi') .'.value="'.$b .'"; submit(); return(false)}'}
				,$p->htmlescape($v) 
				))
                     # !!! variants below does not works, -cmdi hidden variable added for above !!!
                     # .'<font size=-1>' .$g->a({href=>$s->qurl('',$s->pxnme(-pxcb=>'-cmd')=>$b), -onClick=>'{' .$s->pxnme(-pxcb=>$b).'.click(); return(false)}'}, $p->htmlescape($v)) .'</font>'
                     # .'<font size=-1>' .$g->a({href=>$s->qurl('',$s->pxnme(-pxcb=>'-cmd')=>$b), -onClick=>$s->pxnme(-pxcb=>$b).'.click()'}, $p->htmlescape($v)) .'</font>'
              : defined($u)
              ? $g->button(-name=>$s->pxnme(-pxcb=>$b)
		       ,-class=>'MenuArea MenuButton'
                       ,-value=>$b eq '-bck' ? '<-' : $v
                       ,-accesskey=>substr($v,0,1)
                       ,-title=>$t
                       ,%a
                       )
              : $g->submit(-name=>$s->pxnme(-pxcb=>$b)
		       ,-class=>'MenuArea MenuButton'
                       ,-value=>$v
                       ,-accesskey=>substr($v,0,1)
                       ,-title=>$t
                       ,%a)
              ) .' '
       : do{$j =''; $b};
 chomp($h);
#$j ='';
 '<td class="MenuArea MenuButton" valign="middle"'
 .($p->{-iurl} 
	? ' style="border-width: thin; border-style: outset;"'
		.($j
		? ' onmousedown="if(window.event.button==1){this.style.borderStyle=&quot;inset&quot;}" onmouseout="this.style.borderStyle=&quot;outset&quot;" onclick="' .$p->htmlescape($j) .'" title="' .$p->htmlescape($v .'. ' .$t) .'"'
			# onmouseup="this.style.borderStyle=&quot;outset&quot;" 
		: '')
	: '')
 .">\n<nobr>"
 .$h
 ."</nobr></td>\n"
}


sub htmlhid {   # Transaction hidden html
 my $s =shift;
 my $c =$_[0] && substr($_[0],0,1) eq '-' ? shift : '';
 my $r ='';
 my $g =$s->cgi;
 my $lp=length($s->{-pxpv});
 my $lb=length($s->{-pxcb});
 my $lq=length($s->{-pxqc});
 my $ls=length($s->{-pxsw});
                            # store generic transaction command
 $r .=$g->hidden(-name=>$s->pxnme(-pxcb=>'-cmd')
                ,-value=>$s->{-cmdg}
                ,-override=>1) ."\n"
      if $c ne '-lst';
                            # declare immediate or image transaction command
 $r .=$g->hidden(-name=>$s->pxnme(-pxcb=>'-cmdi')
                ,-value=>''
                ,-override=>1) ."\n";

 if ($s->cmd(-sel)) {       # -sel: save previos values after record selection
    foreach my $p ($g->param) {
      next if substr($p, 0, $lp) eq $s->{-pxpv};
      next if substr($p, 0, $lb) eq $s->{-pxcb};
      next if substr($p, 0, $lq) eq $s->{-pxqc};
      next if substr($p, 0, $ls) eq $s->{-pxsw};
      $r .=$g->hidden(-name=>$s->pxnme(-pxpv=>$p)
                     ,-value=>$g->param($p),-override=>1) ."\n"
    }
 }

 if ($s->{-cmde}) {
    $r .=$g->hidden(-name=>$s->pxsw('EDIT'), -value=>'1') ."\n"
 }

 if ($s->cmd eq '-frm') {   # -frm: preserve -pxpv in form recalculations
    foreach my $p ($g->param) {
      next if substr($p, 0, $lp) ne $s->{-pxpv};
      next if substr($p, 0, $lb) eq $s->{-pxcb};
      $r .=$g->hidden(-name=>$p 
                     ,-value=>$g->param($p),-override=>1) ."\n"
    }
 }

 if ($s->cmd(-lst)) {       # -lst: set -pxqc, preserve other fields
    unless ($s->{-lists} 
	&& $s->qlst 
	&& $s->{-lists}->{$s->qlst} 

lib/CGI/Bus/tm.pm  view on Meta::CPAN

sub cmdcrt { # Create Fields
 my $s   =shift;
 my $g   =$s->cgi;
 foreach my $f (@{$s->{-form}}) { 
   next if !ref($f) || ref($f) eq 'CODE' || !$f->{-fld} || !defined($f->{-crt});
   local $_ =$g->param($f->{-fld});
   my $v =ref($f->{-crt}) eq 'CODE' ? &{$f->{-crt}}($s)
         :$f->{-crt};
   $g->param($f->{-fld},$v) if defined($v);
 }
 foreach my $f (@{$s->{-form}}) { 
   next if !ref($f) || ref($f) eq 'CODE' || !$f->{-fld} || defined($f->{-crt});
   $g->delete($f->{-fld});
 }
 $s
}



sub cmdqry { # Query Condition Init
 my $s   =shift;
 my $g   =$s->cgi;
 foreach my $f (@{$s->{-form}}) { 
   next if !ref($f) || ref($f) eq 'CODE' || !$f->{-fld} || !defined($f->{-qry}) 
        || defined($g->param($f->{-fld}));
   my $v =ref($f->{-qry}) eq 'CODE' ? &{$f->{-qry}}($s)
         :$f->{-qry};
   $g->param($f->{-fld},$v) if defined($v);
 }
 $s
}



sub cmdhtm { # Common HTML
  my $s =shift;

  $s->die($s->lng(1,'op!let',$s->lng(0,'-sel')) ."\n")
                     if $s->{-rowsel} && $s->cmd(-sel) && !&{$s->{-rowsel}}($s);
  $s->{-cmde} =undef if $s->{-rowedt} && $s->{-cmde}   && !&{$s->{-rowedt}}($s);

  &{shift @_}(@_) if ref($_[0]) eq 'CODE';
  $s->print($s->htmlbar) if ($s->qparamsw('MIN')||'')  !~/b/;
  $s->print($s->htmlhid);
  $s
}



sub cmdfrm { # Record form for Query or Edit
 my $s =shift;
 my $p =$s->parent;
 my $g =$p->cgi;
 my $c =$_[1] ||substr($s->cmdg||$s->cmd,1,1);
    $c ='e' if $c eq 's' || $c eq 'f';
 my $vm= !$s->{-cmde} && $c eq 'e' && $s->{-opflg} !~/!v/;
 my $mp= $vm && ($s->qparamsw('MIN')||'') =~/bh/i;
 my $rskip =1;
 my $tskip =0;
 if (($s->qparamsw('MIN')||'') !~/h/) {
	$p->print('<div class="MenuArea"><strong class="MenuArea MenuHeader">'
	,$p->htmlescape($p->{-htmlstart}->{-title}||$p->{-htpgstart}->{-title}||'')
	,'</strong><hr class="MenuArea MenuHeader"/></div>',"\n");
 }
 $p->print($s->{-htmlts} ? $s->{-htmlts} : '<table class="Form">', "\n<tr>\n");
 $p->print('<th colspan=20><nobr>' 
          ,('&nbsp;' x $s->{-width}) 
          ,"</nobr></th></tr>\n<tr>\n"
          ) if $s->{-width};
 foreach my $f (@{$s->{-form}}) {
   if    ($f eq '')          {$rskip =1; next}
   elsif ($f eq "\t")        {
          $p->print('</tr><tr>') if !$rskip;
          $rskip =1;
          $p->print->td(' ');
          next
   }
   elsif ($f eq "\f") {
	$tskip =1;
	$p->print("\n</tr>\n", $s->{-htmlte} ? $s->{-htmlte} : "\n</table>\n");
	next
   }
   elsif ($f eq "</table>") {
	$tskip =2;
	$p->print("\n</tr>\n", $s->{-htmlte} ? $s->{-htmlte} : "\n</table>\n");
	next
   }
   elsif (!ref($f))          {$p->print($f); next}
   elsif (ref($f) eq 'CODE') {$p->print(&$f($s)); next}
   elsif (!$f->{-flg}
         ||$f->{-flg} =~/^["'ls]*$/) {next}
   next if !$f->{-fld};

   local $_ =$g->param($f->{-fld});
   my $excl =$f->{-flg} !~/[a$c]/ && !($c =~/[ce]/ && $f->{-flg} =~/[av$c]/);
   my $hide =$c ne 'q' 
           && ((ref($f->{-hide})  eq 'CODE' ? &{$f->{-hide}}($s)  : $f->{-hide})
           ||  (ref($f->{-hidel}) eq 'CODE' ? &{$f->{-hidel}}($s) : $f->{-hidel}));
   my $view =$vm
           ||($f->{-flg} !~/$c[^v]/ 
             &&( $f->{-flg} =~/[a$c]v/ 
               ||($f->{-flg} !~/[a$c]/ && $f->{-flg} =~/v/)));

   $p->print('</tr><tr>') if !$rskip && !$tskip;
   my $lbl =$p->htmlescape($f->{-lbl}||$f->{-fld});
   my $cmt =($f->{-cmt}||$f->{-lbl}||$f->{-fld}) .' [' .$f->{-fld} .': ' .$f->{-flg} .']';

   my $wgh;
   if (!($hide||$excl) && defined($f->{-inphtml})) {
	$wgh =$f->{-inphtml};
	if (ref($wgh) eq 'CODE') {
		$wgh	=&$wgh($s);
		$_	=$g->param($f->{-fld});
	}
	$wgh =~s/< *input\b[^<>]*>//ig	if $vm;
	$wgh =~s/<[\/\s]*a\b[^>]*>//ig	if $mp;
   }

   if ($f->{-frm} && !$vm && !$view && !$excl && !$hide) {
      $s->param($f->{-fld}, $_ =&{$f->{-frm}}($s, $_ =$s->param($f->{-fld})))
   }

   if    ($excl||$hide) {

lib/CGI/Bus/tm.pm  view on Meta::CPAN

         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;
    print "<table>\n";
    foreach my $f (@{$s->{-form}}) {
       next if !$f || ref($f) ne 'HASH' || !$f->{-fld} || !$f->{-cmt};
       print "<tr>";
       print $g->td($ta, '<code>' .$s->htmlescape('[' .$f->{-flg} .']') .'</code>');
       print $g->th($ta, $s->htmlescape($f->{-lbl}||$f->{-fld}));
       print $g->td($ta, '<code>' .$s->htmlescape($f->{-fld}) .'</code>');
       print $g->td($ta, $s->htmlescape($f->{-cmt})
                       .($f->{-col} && $f->{-col} =~/\(/ 
                        ? ('<br /><code> = ' .$s->htmlescape($f->{-col}) .'</code>')
                        : ''));
       print "</tr>\n";
    }
    print "</table>\n";
 }
 if ($o =~/[lo]/ && $s->{-lists}) {
    $sh ='Lists';
    print $g->h2($s->htmlescape($s->lng(0, $sh))),"\n";
    $sh =$s->lng(1, $sh);
    print $g->p($s->htmlescape($sh)),"\n" if $sh;
    my $l =$s->{-lists};
    my @a =sort {lc($l->{$a}->{-lbl}||$l->{$a}->{-lst}||$a) cmp lc($l->{$b}->{-lbl}||$l->{$b}->{-lst}||$b)} keys %$l;
    print "<table>\n";
    foreach my $e (@a) {
      next if !$l->{$e}->{-cmt};
      print "<tr>";
      print $g->th($ta, $s->htmlescape($l->{$e}->{-lbl}||$l->{$e}->{-lst}||$e));
      print $g->td($ta, (ref($l->{$e}->{-cmt}) eq 'ARRAY' 
                        ? join('<br />', map {$s->htmlescape($_)} @{$l->{$e}->{-cmt}}) 
                        : $s->htmlescape($l->{$e}->{-cmt}))
                       .'<code>'
                       .(ref($l->{$e}->{-fields})
                        ? ('<br /> = ' .$s->htmlescape(join(', ',@{$l->{$e}->{-fields}})))
                        : '')
                       .(ref($l->{$e}->{-key})
                        ? (' KEY ' .$s->htmlescape(join(', ',@{$l->{$e}->{-key}})))
                        : '')
                       .(ref($l->{$e}->{-orderby})
                        ? (' ORDER BY ' .$s->htmlescape(join(', ',@{$l->{$e}->{-orderby}})))
                        : '')
                       .($l->{$e}->{-orderby}
                        ? (' ORDER BY ' .$s->htmlescape($l->{$e}->{-orderby}))
                        : '')
                       .'</code>'
                       );
      print "</tr>\n";
    }
    print "</table>\n";
 }
 if ($o =~/[co]/) {
    $sh ='Commands';
    print $g->h2($s->htmlescape($s->lng(0, $sh))),"\n";



( run in 0.709 second using v1.01-cache-2.11-cpan-39bf76dae61 )