ARSObject

 view release on metacpan or  search on metacpan

lib/ARSObject.pm  view on Meta::CPAN

			# $SIG{__DIE__} =$sigdie;
			# &$sigdie(@_) if ref($sigdie) eq 'CODE';
			# CORE::die($_[0]);
		};
		$SIG{__WARN__} =sub{
			return if !$^W ||ineval();
			if ($s && $s->{-warnmsg}) {
				&{$s->{-warnmsg}}(@_)
			}
			else {
				print   '<div style="font-weight: bolder">Warnig: '
					, $s->{-cgi}->escapeHTML($_[0])
					, "<div>\n"
					if $s && $s->{-cgi}
			}
			# CORE::warn($_[0]);
		} if $^W;
	}
 }
 elsif ($a{-vfbase}) {
	if ($a{-vfbase} !~/[\\\/]/) {

lib/ARSObject.pm  view on Meta::CPAN

				];
		foreach my $e ('-labels0','-labels1') {
			next if !$a{$e};
			foreach my $k (keys %{$a{$e}}) {
				$a{-labels}->{$k} =$a{$e}->{$k}
			}
		}
		$a{-values}
		};
 my $ac=$a{-class} ? ' class="' .$a{-class} .'"' : '';
 my $as=$a{-style} ? ' style="' .$a{-style} .'"' : '';
 my $aw=$a{-size} ||80;
 my $v =!defined($s->{-cgi}->param($n)) ||$a{-override}
	? $a{-default}
	: $s->{-cgi}->param($n);
    $v =&$av()->[0]
		if $a{-strict} && (!defined($v) || !grep /^\Q$v\E$/, @{&$av()});
    $s->{-cgi}->param($n, defined($v) ? $v : '');
 my $ek =$s->{-cgi}->user_agent('MSIE') ? 'window.event.keyCode' : 'event.which';
 my $fs =sub{
	'{var k;'
	."var l=window.document.forms[0].$nl;"
	."if(l.style.display=='none'){"
	.($_[0] eq '4' ? '' : 'return(true)') .'}else{'
	.(!$_[0]	# onkeypess - input
	? "if (String.fromCharCode($ek) ==\"\\r\") {${n}__S_.focus(); ${n}__S_.click(); return(true)}; k=window.document.forms[0].$n.value +String.fromCharCode($ek);"
	: $_[0] eq '1'	# onkeypess - list -> input (first char)
	? "if (String.fromCharCode($ek) ==\&quot;\\r\&quot;) {${n}__S_.focus(); ${n}__S_.click(); return(true)}; window.document.forms[0].$n.focus(); k=window.document.forms[0].$n.value =String.fromCharCode($ek); "
	: $_[0] eq '2'	# onkeypess - list -> prompt (selected char)
	# ? "k=prompt('Enter search string',String.fromCharCode($ek));"
	? "if (String.fromCharCode($ek) ==\&quot;\\r\&quot;) {${n}__S_.focus(); ${n}__S_.click(); return(true)}; k =String.fromCharCode($ek); for (var i=0; i <l.length; ++i) {if (l.options.item(i).value.toLowerCase().indexOf(k)==0 || l.options.item(i).text....
	: $_[0] eq '3'	# button - '..'
	? "k=prompt('Enter search substring',''); $nl.focus();"

lib/ARSObject.pm  view on Meta::CPAN

	.'}}'};

 ($s->{-cgi}->param("${n}__O_")
	? "<div><script for=\"$n\" event=\"onkeypress\">" .&$fs(0) ."</script>\n"
	: '')
 .$s->{-cgi}->textfield((map {defined($_) && defined($a{$_})
				? ($_ => $a{$_})
				: $a{-textfield} && $a{-textfield}->{$_} && !$s->{-cgi}->param("${n}__O_")
				? ($_ => $a{-textfield}->{$_})
				: ()
		} qw(-name -title -class -style -size -maxlength))
		, -default=>$v
		, -override=>1
		, ($a{-strict} && !$s->{-cgi}->param("${n}__O_")
			? (-readonly=>1) # ,-hidefocus=>0, -disabled=>0
			: ())
	)
 .($s->{-cgi}->param("${n}__O_")
	? ("<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
	  ."<input type=\"hidden\" name=\"${n}__P_\" value=\"" .(defined($v) ? $s->{-cgi}->escapeHTML($v) : '') ."\"$ac$as />\n"
	  ."<br />\n"

lib/ARSObject.pm  view on Meta::CPAN

sub cfprun {	# Field Player: run
		# (self, msg sub{}
		# , form row sub{}, form top, form bottom) -> success
 my ($s, $cmsg, $cfld, $cfld0, $cfld1) =@_;
 my $hmsg =ref($cmsg) eq 'HASH' 
	? $cmsg 
	: ($s->{-lang} ||'') =~/^ru/i
	? {'Error'=>'Îøèáêà', 'Warning'=>'Ïðåäóïðåæäåíèå', 'Success'=>'Óñïåøíî'
		,'Executing'=>'Âûïîëíåíèå', 'Done'=>'Âûïîëíåíî'}
	: {};
 $cmsg =sub{"\n<br /><font style=\"font-weight: bolder\""
		.($_[1] =~/^(?:Error|Warning)/ ? ' color="red"' : '')
		.'>'
		.(defined($_[1]) ? $_[0]->{-cgi}->escapeHTML($hmsg->{$_[1]} ||$_[1]) : 'undef')
		.": "
		.(defined($_[2]) ? $_[0]->{-cgi}->escapeHTML($hmsg->{$_[2]} ||$_[2]) : 'undef')
		."</font>"
		# 'Error', 'Warning',
		# 'Executing', 'Done'('Success', 'Error')
		}
	if !$cmsg || (ref($cmsg) ne 'CODE');

lib/ARSObject.pm  view on Meta::CPAN

			: !ref($f->{-widget}) && $f->{-widget}
			? $f->{-widget}
			: ref($f->{-widget}) eq 'CODE'
			? &{$f->{-widget}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
			: !$f->{-namecgi}
			? ''
			: ref($f->{-widget}) eq 'HASH'
			? $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
				, %{$f->{-widget}})
			: $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
				, map {defined($f->{$_}) ? ($_=>$f->{$_}) : ()} qw(-class -style));
		next
	}
	elsif ($bb) {
		print &$cfld($s, {}, $bb);
		$bb ='';
	}
	print &$cfld($s
	, $f->{-action} ||$f->{-preact}
		? {}
		: $f

lib/ARSObject.pm  view on Meta::CPAN

			, %{$f->{-widget}})
		: $s->cgistring(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
			, -id => $f->{-namecgi}
			, %{$f->{-widget}})
			)
	: (	 $f->{-values}
		? $s->cgiselect(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
			, -id => $f->{-namecgi}
			, -onchange=>1			
			, map {	my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
				defined($v) ? ($_=>$v) : ()} qw(-values -labels -onchange -readonly -disabled -class -style))
		: $f->{-rows}
		? $s->cgitext(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
			, -id => $f->{-namecgi}
			, map {	my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
				defined($v) ? ($_=>$v) : ()} qw(-rows -columns -maxlength -readonly -class -style))
		: $f->{-action} ||$f->{-preact}
		? $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
			, -id => $f->{-namecgi}
			, map {	my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
				defined($v) ? ($_=>$v) : ()} qw(-class -style))
		: $s->cgistring(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
			, -id => $f->{-namecgi}
			, map {	my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
				defined($v) ? ($_=>$v) : ()} qw(-size -maxlength -readonly -disabled -class -style))
			)
	)
	. (!$f->{-widget1}
		? ''
		: ref($f->{-widget1}) eq 'CODE'
		? &{$f->{-widget1}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
		: $f->{-widget1})
	);
 }
 if ($bb) {



( run in 1.643 second using v1.01-cache-2.11-cpan-49f99fa48dc )