escape results from the CPAN

escape

ARSObject

view release on metacpan or search on metacpan

		$SIG{__DIE__} =sub{
			return if ineval();
			if ($s && $s->{-diemsg}) {
				&{$s->{-diemsg}}(@_)
			}
			else {
				print   $s->{-cgi}->header(-content=>'text/html'
					,($ENV{SERVER_SOFTWARE}||'') =~/IIS/ ? (-nph=>1) : ()
					)
					, "<h1>Error:</h1>"
					, $s->{-cgi}->escapeHTML($_[0])
					, "<br />\n"
					if $s && $s->{-cgi}
			}
			$s->DESTROY() if $s;
			$s =undef;
			# $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} !~/[\\\/]/) {
		my $v =$^O eq 'MSWin32' ? scalar(Win32::GetFullPathName($0)) : $0;

lib/ARSObject.pm view on Meta::CPAN

		,($e && ($e eq '$!') && $^E ? ($! .' / ' .$^E) : ($e || 'unknown error'))
		,($o ? $o : ())
		,($f ? $f .'(' .join(',', map {$s->dsquot($_)} @a) .')' : ())
		,($c ? $c : ())
		)
	)
}


sub strquot {	# Quote and Escape string enclosing in ''
 my $v =$_[1];		# (string) -> escaped
 return('undef') if !defined($v);
 $v =~s/([\\'])/\\$1/g;
 $v =~s/([\x00-\x1f])/sprintf("\\x%02x",ord($1))/eg;
 $v =~/^\d+$/ ? $v : ('\'' .$v .'\'');
}


sub strquot2 {	# Quote and Escape string enclosing in ""
 my $v =$_[1];		# (string) -> escaped
 return('undef') if !defined($v);
 $v =~s/([\\"])/\\$1/g;
 $v =~s/([\x00-\x1f])/sprintf("\\x%02x",ord($1))/eg;
 $v =~/^\d+$/ ? $v : ('"' .$v .'"');
}


sub arsquot {	# Quote string for ARS
 return('NULL') if !defined($_[1]);
 my $v =$_[1];

lib/ARSObject.pm view on Meta::CPAN

	};
 };
# print do($s->vfname('-meta-sql'))||0,' ', $@||'', $s->vfname('-meta-sql'),' ', "\n";
 $s->vfload('-meta-sql') if !$s->{'-meta-sql'} && $s->{-schgen};
 $s;
}



sub sqlnesc {	# SQL name escaping, default for '-sqlname', '-sqlntbl', '-sqlncol'
 my $v =lc($_[1]); # (self, name) -> escaped
 $v =~s/[^a-zA-Z0-9_]/_/g;
 $v =substr($v,0,64) if length($v) >64;
 $v
}


sub sqlninc {	# SQL name incrementing, default for '-sqlninc'
 my $v =$_[1];	# (self, name) -> incremented
 my ($n, $nn);
 if (0) {

lib/ARSObject.pm view on Meta::CPAN

				: ()
		} 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"
	  ."<select name=\"${n}__L_\" title=\"select value\" size=\"10\""
	  ."$ac$as"
	  ." ondblclick=\"{${n}__S_.focus(); ${n}__S_.click(); return(true)}\"" 
	  ." onkeypress=\"" .($s->{-cgi}->user_agent('MSIE') ? &$fs(1) : &$fs(2)) 
	  ."\">\n"
	  .join('',map {'<option'
			.((defined($v) ? $v : '') eq (defined($_) ? $_ : '') ? ' selected' : '')
			.' value="' .$s->{-cgi}->escapeHTML(defined($_) ? $_ : '') .'">' 
				.$s->{-cgi}->escapeHTML(
					!defined($_)
					? ''
					: !$a{-labels}
					? (length($_) > $aw ? substr($_,0,$aw) .'...' : $_)
					: defined($a{-labels}->{$_})
					? (length($a{-labels}->{$_}) > $aw ? substr($a{-labels}->{$_},0,$aw) .'...' : $a{-labels}->{$_})
					: '') ."</option>\n"
			} @{&$av()})
	  ."</select>\n"
	  ."<input type=\"submit\" name=\"${n}__S_\" value=\"&lt;\" title=\"set\"$ac$as />"

lib/ARSObject.pm view on Meta::CPAN

		)
	: ("<input type=\"submit\" name=\"${n}__O_\" value=\"...\" title=\"open\"$ac$as />"
	 .($s->{-cgi}->param("${n}__C_") ||$s->{-cgi}->param("${n}__X_")
		? "<script for=\"window\" event=\"onload\">{window.document.forms[0].${n}__O_.focus()}</script>"
		: ''
		))
	)
}


sub cgiesc {	# escape strings to html
	$_[0]->{-cgi}->escapeHTML(@_[1..$#_])
}


sub cgitfrm {	# table form layot
		# -form =>{form attrs}, -table=>{table attrs}, -tr=>{tr attrs}, -td=>{}, -th=>{}
 my ($s, %a) =$_[0];
 my $i =1;
 while (ref($_[$i]) ne 'ARRAY') {$a{$_[$i]} =$_[$i+1]; $i +=2};
 $s->cgi->start_form(-method=>'POST',-action=>'', $a{-form} ? %{$a{-form}} : ())
	# ,-name=>'test'

lib/ARSObject.pm view on Meta::CPAN

 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');
 my $emsg =sub{	
		$CGI::Carp::CUSTOM_MSG
		? &$CGI::Carp::CUSTOM_MSG($_[1])
		: print(&$cmsg($_[0], 'Error', $_[1]))
		};
 $cfld =sub{"\n<tr><th align=\"left\" valign=\"top\">"
		. ($_[1]->{-namehtml}
			? &{$_[1]->{-namehtml}}(@_)
			: $_[0]->{-cgi}->escapeHTML($_[1]->{-namelbl}||''))
		. "</th>\n<td align=\"left\" valign=\"top\">"
		. $_[2]
		. "</td></tr>"
		}
	if !$cfld;
 $cfld0="\n<table>"	if !$cfld0;
 $cfld1="\n</table>"	if !$cfld1;
 $s->cgi();
 cfpinit($s);
 local $s->{-fpmsg} =$cmsg;

lib/ARSObject.pm view on Meta::CPAN

	if $acf;
 foreach my $f (@{$s->{-fpl}}) {
	next	if (ref($f) ne 'HASH')
		|| (exists($f->{-used}) && !$f->{-used});
	next if exists($f->{-widget}) && !defined($f->{-widget});
	next if !$f->{-namecgi};
	my $u =cfpused($s, $f);
	next if $u && !($f->{-hidden} ||((ref($f->{-values}) eq 'ARRAY') && !scalar(@{$f->{-values}})));
	print 	defined(cfpvp($s, $f)) 
		? '<input type="hidden" name="' .$f->{-namecgi} .'__PV_" value="' 
			.$s->{-cgi}->escapeHTML(cfpvp($s, $f))
			.'" />' ."\n"
		: ''
		, !$u
		? (	defined($s->{-cgi}->param($f->{-namecgi}))
			? '<input type="hidden" name="' .$f->{-namecgi} .'" value="'
				.$s->{-cgi}->escapeHTML($s->{-cgi}->param($f->{-namecgi}))
				.'" />' ."\n"
			: '')
		: defined(cfpvv($s, $f))
		? '<input type="hidden" name="' .$f->{-namecgi} .'" value="'
			.$s->{-cgi}->escapeHTML(cfpvv($s, $f))
			.'" />' ."\n"
		: '';
 }
 print ref($cfld0) ? &{$cfld0}($s) : $cfld0;
 my $bb ='';
 foreach my $f (@{$s->{-fpl}}) {
	next	if (ref($f) ne 'HASH')
		|| (exists($f->{-used}) && !$f->{-used});
	next if !cfpused($s, $f);
	next if exists($f->{-widget}) && !defined($f->{-widget});

lib/ARSObject.pm view on Meta::CPAN

	, $f->{-action} ||$f->{-preact}
		? {}
		: $f
	, (!$f->{-widget0}
		? ''
		: ref($f->{-widget0}) eq 'CODE'
		? &{$f->{-widget0}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
		: $f->{-widget0})
	. (!($f->{-action} || $f->{-preact}) && $f->{-namecgi} && defined(cfpvp($s, $f))
		? '<input type="hidden" name="' .$f->{-namecgi} .'__PV_" value="' 
			.$s->{-cgi}->escapeHTML(cfpvp($s, $f))
			.'" />'
		: ''
		)
	. (!ref($f->{-widget}) && exists($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'

lib/ARSObject.pod view on Meta::CPAN


	=> not exists || 'comment text'

=item -namehtml

	=> not exists || sub{}(self, {field}, 'widget html') -> 'label html'

(C<CGI Form Presenter - Field Definitions>)
Field names, label, comment text.
If C<-name> exists, it's value may be used as C<-namedb>,
and escaped value may be used as C<-namecgi>.


=item -maxRetrieve

	=> 0 || number of rows

(C<ARS methods>)
Max number of rows to retrieve from ARS server with C<query> method.

lib/ARSObject.pod view on Meta::CPAN

(C<Utility Objects>)
L<Net::SMTP|Net/SMTP> utility object and connect specification to create it.
See also C<smtp> and C<smtpconnect> methods.


=item -sqlname

	=> undef || sub{}(self, ARS name) -> SQL name

(C<SQL Data Store Methods>)
sub{} to escape ARS name to the SQL name, 
may be used instead of C<-sqlntbl> and C<-sqlncol>.
See also C<-sqlninc>.
See 'sub sqlnesc' in the source code as an example.


=item -sqlncol

	=> undef || sub{}(self, ARS field name) -> SQL col name

(C<SQL Data Store Methods>)
sub{} to escape ARS field name to the SQL column name, see also C<-sqlntbl>, C<-sqlninc>.
See 'sub sqlnesc' in the source code as an example.


=item -sqlninc

	=> undef || sub{}(self, SQL name) -> SQL name incremented

(C<SQL Data Store Methods>)
sub{} to increment SQL name, used after C<-sqlname>/C<-sqlntbl>/C<-sqlncol>
when the same SQL name already exists.
See 'sub sqlninc' in the source code as an example.


=item -sqlntbl

	=> undef || sub{}(self, ARS form name) -> SQL table name


(C<SQL Data Store Methods>)
sub{} to escape ARS form name to the SQL table name, see also C<-sqlncol>, C<-sqlninc>.
See 'sub sqlnesc' in the source code as an example.


=item -sqlschema

	=> undef || SQL schema name

(C<SQL Data Store Methods>)
SQL schema name for C<dbidsmetasync>(), C<dbidsrpl>(), C<dbidsquery>().

lib/ARSObject.pod view on Meta::CPAN

	$s->connect();
	$s->arsmetamin();


=item arsmetasql (-param => value,...)

(C<Metadata>, C<SQL Data Store Methods>)

Load SQL Data Store metadata or refresh this from ARS metadata after C<connect>/C<arsmeta> call.
The SQL Data Store is intended for data replicated from ARS using C<dbidsrpl>() calls.
Database table and column names are escaped ARS form and field names.
Metadata is stored in C<-meta-sql> variable file.

Synopsis: Refreshing C<-meta-sql>:

	$s->set(-schgen =>3);
	$s->connect();
	$s->dbi();
	$s->arsmetasql();
	$s->dbidsmetasync();

See also C<sqlname>(), C<dbidsmetasync>(), C<dbidsrpl>(), C<dbidsquery>()


=item arsquot (string) -> escaped and quoted for ARS

Quote and escape string for ARS.
See also C<strquot>/C<strquot2>



=item AUTOLOAD ()

(C<ARS methods>)
Use object->arsXXX() syntax for ARS:ars_XXX(ctrl,...) calls.

lib/ARSObject.pod view on Meta::CPAN

=item cgiddlb (-name=>name, ?-title=>comment, ?-values=>[values], ?-labels=>{value=>display,..}, ?-default=>value, ?-override=>bool,...) -> drop-down list box HTML

(C<Utility Objects>)
Generate drop-down list box HTML using L<CGI|CGI> widgets.
This is alike C<cgiselect>, but more complex.

 -strict=> - disable text editing, allow only to choose value from list



=item cgiesc (string) -> escaped string

(C<Utility Objects>)
Escape string to HTML using L<CGI|CGI>->escapeHTML(@_)



=item cgitfrm (?-table=>{table attrs}, ?-tr=>{tr attrs}, ?-td=>{...}, ?-th=>{...}, [cell value,...],...) -> HTML

(C<Utility Objects>)
Generate simple HTML form in table layout using L<CGI|CGI>->start_form(),
L<CGI|CGI>->table(), L<CGI|CGI>->end_form().
'th' tag will be used for simple strings as usual labels, 'td' tag - for strings started with HTML tags.

lib/ARSObject.pod view on Meta::CPAN


(C<ARS methods>)
Convert ARS field value for external representation.
Called automatically when C<-strFields>. 
Should be called explicitly from C<strOut> sub{} in C<-metadn>/C<-metaid>
and when parsing strings result from C<query>.
See also C<strIn>, C<-strFields>.



=item strquot (string) -> escaped and quoted with ''

=item strquot2 (string) -> escaped and quoted with ""

(C<Utility Methods>)
Quote and escape string.
See also C<arsquot>



=item strtime (?mask, L<time|perlfunc> ||L<localtime|perlfunc> ||L<gmtime|perlfunc>) -> stringified

(C<Utility Methods>)
Stringify time value by mask.
Default mask is 'yyyy-mm-dd hh:mm:ss' (ISO).
L<POSIX::strftime|POSIX> uses different mask agreement.

( run in 0.409 second using v1.01-cache-2.11-cpan-c21f80fb71c )