view release on metacpan or  search on metacpan

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

 }
 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=>''

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

		next	if $p eq $s->pxnme(-pxsw=>'FRMCOUNT')
			|| $p eq $s->pxnme(-pxsw=>'FTEXT')
			|| $p eq $s->pxnme(-pxsw=>'EDIT')
			|| $p eq $s->pxnme(-pxsw=>'LIST');
		# $r .=$g->hidden(-name=>$s->pxnme(-pxqc=>$p)	# pxqc off
		# 	,-value=>$g->param($p),-override=>1) ."\n";
		$r .=$g->hidden(-name=>$p
			,-value=>$g->param($p),-override=>1) ."\n"
	}
    }
 }
 else {                     # preserve -pxqc when data edit
    # foreach my $p ($g->param) {	# pxqc off
    #   next if substr($p, 0, $lq) ne $s->{-pxqc};
    #   next if substr($p, 0, $lb) eq $s->{-pxcb};
    #   $r .=$g->hidden(-name=>$p 
    #                  ,-value=>$g->param($p),-override=>1) ."\n"
    # }
    #$r .=$g->hidden(-name=>'_run'			# cargo
	#	   ,-value=>$g->param('_run')
	#	   ,-override=>1) ."\n"
	#	if $g->param('_run') && $s->cmd(-qry);
    $r .=$g->hidden(-name=>$s->pxnme(-pxsw=>'LSO')	# list options
		   ,-value=>$g->param($s->pxnme(-pxsw=>'LSO'))
		   ,-override=>1) ."\n"
		if $g->param($s->pxnme(-pxsw=>'LSO')) && $s->cmd(-qry);
    $r .=$g->hidden(-name=>$s->pxnme(-pxsw=>'FRMCOUNT')
                   ,-value=>($g->param($s->pxnme(-pxsw=>'FRMCOUNT'))||0) +1
                   ,-override=>1) ."\n"
 }

 $r ."\n"
}


sub htmlself { # Self Hyperlink
 my $s =shift;
 my $d =pop;
 my $a =ref($_[$#_]) ? pop : ref($_[0]) ? shift :[];
 $s->a({href=>$s->htmlurl($s->qurl,$s->pxnme(-pxcb=>'-cmd'), @_)
       ,-target=>$s->{-formtgf}
       ,(ref($a) eq 'ARRAY' ? @$a : %$a)}
       ,$d)
}


sub htmlres {   # Transaction command result msg html
 my $s =$_[0];
 my $g =$s->cgi;
 my $c =defined($_[1]) ? $_[1] : !$@;
 my $m =defined($_[2]) ? $_[2] :  $@||'';
 my $t =scalar(@{$s->pushmsg}) >1 ||(scalar(@{$s->pushmsg}) ==1 && $s->pushmsg->[0] ne 'COMMIT');
 my $r ='';
 if (!$s->parent->{-cache} ||!$s->parent->{-cache}->{-httpheader}) {
    $r =$s->parent->htpgstart;
 }

 if (!$c) {
    my $h=$s->lng(0,'Failure') ." '" .$s->lng(0,$s->{-cmd}) ."': ";
    my $e=$s->htmlescape($m);
    $r	.='<span class="FooterArea" onclick="{_tsw_FooterArea.style.display=(_tsw_FooterArea.style.display==\'none\' ? \'inline\' : \'none\')}" style="cursor: hand; ">';
    $r	.='<span class="FooterArea ErrorMessage">' .$g->hr ."<h1 class=\"FooterArea ErrorMessage\">$h</h1>" .$e ."</span>\n";
    $r	.='<hr class="FooterArea" />';
 }
 elsif ((grep {$s->{-cmd} eq $_} qw(-sel -ins -upd -del)) ||$t) {
    $r	.='<span class="FooterArea" onclick="{_tsw_FooterArea.style.display=(_tsw_FooterArea.style.display==\'none\' ? \'inline\' : \'none\')}" style="cursor: hand; ">'
	.'<hr class="FooterArea" />'
	.'<strong class="FooterArea">'
	.($s->cmd('-lst') && $s->{-genlstm} 
		? $s->{-genlstm}
		: ($s->lng(0,'Success') ." '" .$s->lng(0,$s->{-cmd}) ."'"))
	."</strong>\n";
    $r .=$s->htmlescape($s->parent->set('-problem')) ."\n" if $s->parent->set('-problem')
 }
 if ($r && (!$c || ($s->parent->{-debug}) >0)) {
    my $r1 =join(";<br /><br />\n"
		, map { $_ =~/^((?:WARN|WARNING|ERROR|DIE)[:.,\s]+)(.*)$/i
			? "<strong>$1</strong>" .$s->htmlescape($2)
			: $s->htmlescape($_)
			} @{$s->pushmsg});
    $r1  ='<span id="_tsw_FooterArea" style="'
	.(($s->parent->{-debug} ||0) >1 ? 'display: inline; ' : 'display: none; ')
	.'font-size: smaller; ">'
	.$r1
	.'</span>';
    $r  .="<br />\n" .$r1
 }
 if (!$c) {
    $s->pushlog('Error ' .$m, @{$s->pushmsg}, '<---Error');
 }
 elsif ($t && (grep {$s->{-cmd} eq $_} qw(-ins -upd -del))) {
    my @t;
    foreach my $t (@{$s->pushmsg}) {
       next if $t !~/^(insert|update|delete)\s/i;
       push @t, $t
    }
    $s->pushlog(@t);
 }
 $r .='</span>' if $r;
 $r
}


sub eval {     # Transaction run
 my $s =shift;
 my $r =ref($_[$#_]) eq 'CODE' ? pop : sub{$s->cmd('-cmd')};
 my $e =undef;
 local $s->parent->{-problem} ='';
 if (!CORE::eval {
   $r =&$r($s);
   1;
 }) {
    $e =$@ ||'Undefined Error';
    $r =undef
 }
 print $s->htmlres(!$e,$e) if $e ||($s->qparamsw('MIN')||'') !~/r/;
 $r
}


sub evaluate { # Execution of tm
 my $s =shift;
 my $p =$s->parent;
 $s->userauthopt;
 $p->{-debug} && $p->{-cache}->{-RevertToSelf}
 && $s->pushmsg('w32IISdpsn(' .(defined($p->{-w32IISdpsn}) ? $p->{-w32IISdpsn} : 'undef') .')'.($p->{-debug} >2 ? ' '. $p->{-cache}->{-RevertToSelf} : ''));