view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
view all matches for this distribution
view release on metacpan or search on metacpan
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_byte|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
#ifndef PERL_PV_PRETTY_REGPROP
# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
#endif
/* Hint: pv_escape
* Note that unicode functionality is only backported to
* those perl versions that support it. For older perl
* versions, the implementation will fall back to bytes.
*/
#ifndef pv_escape
#if defined(NEED_pv_escape)
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
static
#else
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
#endif
#ifdef pv_escape
# undef pv_escape
#endif
#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
#define Perl_pv_escape DPPP_(my_pv_escape)
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
char *
DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
const STRLEN count, const STRLEN max,
STRLEN * const escaped, const U32 flags)
{
const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
char octbuf[32] = "%123456789ABCDF";
STRLEN wrote = 0;
wrote++;
}
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
break;
}
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
sv_catpvs(dsv, "...");
return SvPVX(dsv);
}
view all matches for this distribution
view release on metacpan or search on metacpan
ModProxyPerlHtml.pm view on Meta::CPAN
$$data =~ s/([^\\\/]['"])($replacement|$pattern)([^'"]*['"])/$1$replacement$3/ig;
$$data =~ s/\%\%REPLACE(\d+)\%\%/$replace_fct{$1}/g;
# Some use escaped quote - Do you have better regexp ?
$$data =~ s/(\")($replacement|$pattern)(.*\")/$1$replacement$3/ig;
# Try to set a fully qualified URI
$uri =~ s/$replacement.*//;
# Replace meta refresh URLs
ModProxyPerlHtml.pm view on Meta::CPAN
imgUp.src = '/URL/images/' + varPath + '/URL/' + 'up.png';
To avoid the second replacement, write your JS code like that:
imgUp.src = '/images/' + varPath + unescape('%2F') + 'up.png';
ModProxyPerlHTML replacement is activated on certain HTTP Content Type. If you
experienced that replacement is not activated for your file type, you can use the
ProxyHTMLContentType configuration directive to redefined the HTTP Content Type
that should be parsed by ModProxyPerlHTML. The default value is the following
view all matches for this distribution
view release on metacpan or search on metacpan
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_byte|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
#ifndef PERL_PV_PRETTY_REGPROP
# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
#endif
/* Hint: pv_escape
* Note that unicode functionality is only backported to
* those perl versions that support it. For older perl
* versions, the implementation will fall back to bytes.
*/
#ifndef pv_escape
#if defined(NEED_pv_escape)
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
static
#else
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
#endif
#ifdef pv_escape
# undef pv_escape
#endif
#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
#define Perl_pv_escape DPPP_(my_pv_escape)
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
char *
DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
const STRLEN count, const STRLEN max,
STRLEN * const escaped, const U32 flags)
{
const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
char octbuf[32] = "%123456789ABCDF";
STRLEN wrote = 0;
wrote++;
}
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
break;
}
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
sv_catpvs(dsv, "...");
return SvPVX(dsv);
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/PageKit.pm view on Meta::CPAN
$apr->pnotes(r_args => $args);
}
if($exclude_param && @$exclude_param){
my %exclude_param_hash = map {$_ => 1} @$exclude_param;
return join ('&', map { Apache2::Util::escape_path("$_", $apr->pool) ."=" . Apache2::Util::escape_path(defined($args->{$_}) ? $args->{$_} : "", $apr->pool )}
grep {!exists $exclude_param_hash{$_}} keys %$args);
} else {
return join ('&', map { Apache2::Util::escape_path("$_", $apr->pool) ."=" . Apache2::Util::escape_path(defined($args->{$_}) ? $args->{$_} : "", $apr->pool)} keys %$args);
}
}
sub update_session {
my ($pk, $auth_session_id) = @_;
lib/Apache2/PageKit.pm view on Meta::CPAN
}
# $view->param(pkit_selfurl => $pkit_selfurl);
$output_param_object->param(pkit_hostname => $host);
# my $pkit_done = Apache2::Util::escape_path($apr->param('pkit_done') || $uri_with_query, $apr->pool);
my $pkit_done = $apr->param('pkit_done') || $uri_with_query;
# $pkit_done =~ s/"/\%22/g;
# $pkit_done =~ s/&/\%26/g;
# $pkit_done =~ s/\?/\%3F/g;
lib/Apache2/PageKit.pm view on Meta::CPAN
$done =~ s/ /+/g;
if(my @pkit_messages = $apr->param('pkit_messages')){
for my $message (@pkit_messages){
$done .= "&pkit_messages=" . Apache2::Util::escape_path($message, $apr->pool);
}
}
if(my @pkit_error_messages = $apr->param('pkit_error_messages')){
for my $message (@pkit_error_messages){
$done .= "&pkit_error_messages=" . Apache2::Util::escape_path($message, $apr->pool);
}
}
$apr->headers_out->set(Location => "$done");
return 1;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/Pod/PodSimpleHTML.pm view on Meta::CPAN
my $to = shift;
my $section = shift;
my $link = $to;
return uri_escape( $link );
}
1;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/PodBrowser.pm view on Meta::CPAN
If the POD file name doesn't contain a dot (C<.>) the last path component
is stripped off to get the directory name.
Note that you need to write the package name again. You also need to
either escape the semicolons as in
C<src="Apache2%3A%3APodBrowser/torsten-foertsch.jpg"> or put a C<./>
in front of the link.
A note about the content type of linked documents. C<Apache::PodBrowser>
does not enter a new request cycle to ship these documents. So, the normal
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/REST/Handler.pm view on Meta::CPAN
- Build a dynamic handler.
For instance if the fragment is an item ID, you might want to build an item handler with this particular item. See L<Apache2::REST::Handler::test> for an example.
- Rerouting outside of the handler classes space.
If you want to escape the default class resolution mecanism.
=cut
sub buildNext{
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/Response/FileMerge.pm view on Meta::CPAN
my( $r ) = @_;
%loaded = ();
%VARS = map {
my( $k, $v ) = split(/=/);
$k => URI::Escape::uri_unescape( ( $v || '' ) )
} split( /[&;]/, $r->args() );
}
sub _load_content {
my ( $root, $location, $file_name, $type ) = @_;
lib/Apache2/Response/FileMerge.pm view on Meta::CPAN
else {
$LOG->error("File not found: \"$file_name\".");
return;
}
$content = _sf_escape($content);
while ( $content =~ /(\/\\\*\\\*\s*[Ii]nc(?:lude)\s*([-\{\}\w\.\/]+)\s*\\\*\\\*\/)/sgm ) {
my ( $matcher, $file ) = ( $1, $2 );
my ( $inc_file, $inc_type ) = $file =~ /^(.*?)\.(js|css)$/;
my $new_file_content = _load_content( $root, '', $inc_file, $inc_type ) || '';
$new_file_content = sprintf( COMMENT_PATTERN, "$root/$inc_file" )
. "\n\n$new_file_content" if ( $APPEND_INC_NAME );
$content =~ s/\/\\\*\\\*\s*[Ii]nc(?:lude)\s*[-\{\}\w\.\/]+\s*\\\*\\\*\//$new_file_content/sm;
}
return _sf_unescape($content);
}
sub _substitute_vars {
foreach my $string ( @_ ) {
while( $$string =~ /\{\s*([\w-]+)\s*\}/g ) {
lib/Apache2/Response/FileMerge.pm view on Meta::CPAN
);
return $DO_COMPRESS;
}
sub _sf_escape {
my ($escaper) = @_;
$escaper =~ s/\*/\\*/g;
return $escaper;
}
sub _sf_unescape {
my ($escaper) = @_;
$escaper =~ s/\\\*/\*/g;
return $escaper;
}
sub _register_function {
my ( $class, $func, $ref ) = @_;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/S3.pm view on Meta::CPAN
$h->{'Authorization'} = _signature $keyId, $keySecret, join "\n",
$r->method,
$h->{'Content-MD5'} || "",
$h->{'Content-Type'} || "",
$h->{'Date'},
uri_escape($path, $ESCAPE).($sub ? "?$sub" : "");
return Apache2::Const::OK;
}
sub _xml_get_tags
lib/Apache2/S3.pm view on Meta::CPAN
$ret .= qq|<html><body><pre>|;
$ret .= qq|<a href="|.("$stripped$prefix" =~ m|^(.*/)[^/]+/$| ? $1 : "/").qq|">Parent Directory</a>\n|;
$ret .= qq|<a href="?marker=|.(uri_escape $next_marker).qq|">Next Page</a>\n|
if $is_truncated and $next_marker;
$ret .= sprintf(qq|<a href="%s">%s</a>%s %-18s %s\n|,
$stripped.uri_escape($_->{Name}, $ESCAPE),
HTML::Entities::encode($_->{DisplayName}),
" "x(87 - length $_->{DisplayName}),
$_->{LastModified} ? strftime("%d-%b-%Y %H:%M", localtime($_->{LastModified})) : "-",
$_->{Size} ? APR::String::format_size($_->{Size}) : "")
foreach map {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/SSI.pm view on Meta::CPAN
)
)
)
/xsmi;
our $SUPPORTED_FUNCTIONS = qr/(base64|env|escape|http|ldap|md5|note|osenv|replace|req|reqenv|req_novary|resp|sha1|tolower|toupper|unbase64|unescape)/i;
our $FUNCTION_PARAMETERS_RE = qr/
[[:blank:]\h]* # Some possible leading blanks
(?:
(?:
(?<func_quote>(?<func_quote_2>\")|(?<func_quote_1>\')) # quotes used to enclose function parameters
lib/Apache2/SSI.pm view on Meta::CPAN
local $@;
# try-catch
my $rv = eval
{
require URI::Escape::XS;
return( URI::Escape::XS::uri_unescape( @_ ) );
};
if( $@ )
{
return( $self->error( "Error while decoding uri: $@" ) );
}
lib/Apache2/SSI.pm view on Meta::CPAN
local $@;
# try-catch
my $rv = eval
{
require URI::Escape::XS;
# return( URI::Escape::uri_escape_utf8( join( '', @_ ) ) );
return( URI::Escape::XS::uri_escape( join( '', @_ ) ) );
};
if( $@ )
{
return( $self->error( "Error while encoding uri: $@" ) );
}
lib/Apache2/SSI.pm view on Meta::CPAN
}
}
# Functions
# See https://httpd.apache.org/docs/trunk/en/expr.html#page-header
# base64|env|escape|http|ldap|md5|note|osenv|replace|req|reqenv|req_novary|resp|sha1|tolower|toupper|unbase64|unescape
sub parse_func_base64 { return( shift->encode_base64( join( '', @_ ) ) ); }
# Return first match of note, reqenv, osenv
sub parse_func_env
{
lib/Apache2/SSI.pm view on Meta::CPAN
{
return( $env->{ $var } || $self->notes( $var ) );
}
}
sub parse_func_escape { return( shift->encode_uri( join( '', @_ ) ) ); }
sub parse_func_http
{
my $self = shift( @_ );
my $header_name = shift( @_ );
lib/Apache2/SSI.pm view on Meta::CPAN
return( uc( join( '', @_ ) ) );
}
sub parse_func_unbase64 { return( shift->decode_base64( join( '', @_ ) ) ); }
sub parse_func_unescape { return( shift->decode_uri( join( '', @_ ) ) ); }
sub parse_if
{
my( $self, $args ) = @_;
unshift( @{$self->{if_state}}, 0 );
lib/Apache2/SSI.pm view on Meta::CPAN
$ssi->decode_entities( 'Tous les êtres humains naissent libres et égaux en dignité et en droits.' );
# Tous les êtres humains naissent libres et égaux en dignité et en droits.
=head2 decode_uri
Decode uri encoded data. This uses L<URI::Escape/uri_unescape>.
Not to be confused with x-www-form-urlencoded data. For that see L</decode_url>
If an error occurred during decoding, it will return undef and set an L</error> object accordingly.
lib/Apache2/SSI.pm view on Meta::CPAN
Encode data provided into md5. This uses L<Digest::MD5> which it will attempt to load.
=head2 encode_uri
Encode uri data. This uses L<URI::Escape::XS/uri_escape>.
Not to be confused with x-www-form-urlencoded data. For that see L</encode_url>
If an error occurred during encoding, it will return undef and set an L</error> object accordingly.
lib/Apache2/SSI.pm view on Meta::CPAN
Showing Japanese data
<!--#else -->
Defaulting to English
<!--#endif -->
=head2 parse_func_escape
Escape special characters in %hex encoding.
Example:
<!--#set var="website" value="https://www.example.com/" -->
Please go to <a href="<!--#echo var='website' encoding='escape' -->"><!--#echo var="website" --></a>
=head2 parse_func_http
Get HTTP request header; header names may be added to the Vary header.
lib/Apache2/SSI.pm view on Meta::CPAN
This worked!
<!--#else -->
Nope, it failed.
<!--#endif -->
=head2 parse_func_unescape
Unescape %hex encoded string, leaving encoded slashes alone; return empty string if %00 is found.
Example:
<!--#if expr="unescape('https%3A%2F%2Fwww.example.com%2F') == 'https://www.example.com/'" -->
This worked!
<!--#else -->
Nope, it failed.
<!--#endif -->
lib/Apache2/SSI.pm view on Meta::CPAN
=item C<base64>
=item C<env>
=item C<escape>
=item C<http>
=item C<ldap>
lib/Apache2/SSI.pm view on Meta::CPAN
=item C<toupper>
=item C<unbase64>
=item C<unescape>
=back
=head2 variables
view all matches for this distribution
view release on metacpan or search on metacpan
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_byte|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
#ifndef PERL_PV_PRETTY_REGPROP
# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
#endif
/* Hint: pv_escape
* Note that unicode functionality is only backported to
* those perl versions that support it. For older perl
* versions, the implementation will fall back to bytes.
*/
#ifndef pv_escape
#if defined(NEED_pv_escape)
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
static
#else
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
#endif
#ifdef pv_escape
# undef pv_escape
#endif
#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
#define Perl_pv_escape DPPP_(my_pv_escape)
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
char *
DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
const STRLEN count, const STRLEN max,
STRLEN * const escaped, const U32 flags)
{
const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
char octbuf[32] = "%123456789ABCDF";
STRLEN wrote = 0;
wrote++;
}
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
break;
}
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
sv_catpvs(dsv, "...");
return SvPVX(dsv);
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/TaintRequest.pm view on Meta::CPAN
sub handler {
my $r = shift;
$r = Apache2::TaintRequest->new($r);
my $querystring = $r->query_string();
$r->print($querystring); # html is escaped...
$querystring =~ s/<script>//;
$r->print($querystring); # html is NOT escaped...
}
=cut
use Apache2::RequestRec;
lib/Apache2/TaintRequest.pm view on Meta::CPAN
$self{request} = $r;
return \%self;
}
*escape_html = \&HTML::Entities::encode_entities;
sub print {
my ( $self, @data ) = @_;
foreach my $value (@data) {
# Dereference scalar references.
$value = $$value if ref $value eq 'SCALAR';
# Escape any HTML content if the data is tainted.
$value = escape_html($value) if tainted($value);
}
$self->{request}->SUPER::print(@data);
}
lib/Apache2/TaintRequest.pm view on Meta::CPAN
=back
One of the harder problems facing web developers involves dealing with
potential cross site scripting attacks. Frequently this involves many
calls to HTML::Entities::escape_html().
This module aims to automate this tedious process. It overrides the
print mechanism in the mod_perl Apache module. The new print method
tests each chunk of text for taintedness. If it is tainted we assume
the worst and html-escape it before printing.
Note that this module requires that you have the line
PerlSwitches -T
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apache2/Translation/Admin/my.js view on Meta::CPAN
}
}
function update_header( counter, key, uri ) {
if( uri==":PRE:" || uri==":LOOKUPFILE:" ) {
Element.update( 'header'+counter, key.escapeHTML() );
} else {
Element.update( 'header'+counter,
key.escapeHTML()+" <img class=\"pfeil\" src=\"pfeil.gif\"> "+ uri.escapeHTML() );
}
}
function xupdate( counter, o, focus ) {
if(o) o.blur();
lib/Apache2/Translation/Admin/my.js view on Meta::CPAN
' ADM_NBLOCKS="1">'+
' <table class="tdc">'+
' <tr>'+
' <td class="tdcol1">New Key:</td>'+
' <td class="tdcol2">'+
' <input type="text" name="newkey" id="key'+next_counter+'" value="'+key.escapeHTML()+'">'+
' </td>'+
' </tr>'+
(uri==":PRE:" || uri==":LOOKUPFILE:"
? (' <input type="hidden" name="newuri" id="uri'+next_counter+'" value="'+uri.escapeHTML()+'">')
: (' <tr>'+
' <td class="tdcol1">New Uri:</td>'+
' <td class="tdcol2">'+
' <input type="text" name="newuri" id="uri'+next_counter+'" value="'+uri.escapeHTML()+'">'+
' </td>'+
' </tr>'))+
' <tr><th colspan="2"><br>Action</th></tr>'+
' <tr class="tdc">'+
' <td ADM_BLOCK="0" ADM_ORDER="" ADM_ID=""'+
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
view all matches for this distribution
view release on metacpan or search on metacpan
usr/share/webapp-toolkit/extra/htdocs/admin/js/cookie.js view on Meta::CPAN
if (end == -1) {
end = obj.length;
}
return unescape(obj.substring(beg + arg.length, end));
}
function setCookie(name, value, expires, path, domain, secure) {
document.cookie = name + "=" + escape(value) +
((expires) ? "; expires=" + expires.toGMTString() : "") +
((path) ? "; path=" + path : "") +
((domain) ? "; domain=" + domain : "") +
((secure) ? "; secure" : "");
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ApacheLog/Compressor.pm view on Meta::CPAN
use Socket qw(inet_aton inet_ntoa);
use Date::Parse qw(str2time);
use List::Util qw(min);
use URI;
use URI::Escape qw(uri_unescape);
use DateTime;
use Encode qw(encode_utf8 decode_utf8 FB_DEFAULT is_utf8 FB_CROAK);
use POSIX qw{strftime};
our $VERSION = '0.005';
lib/ApacheLog/Compressor.pm view on Meta::CPAN
return $data->{url} = '' unless defined $data->{url};
($data->{url}, $data->{query}) = split /\?/, $data->{url}, 2;
# Dodgy UTF8 handling, currently disabled - no guarantee that URLs are UTF8 anyway
# if(length $data->{url}) {
# URI::Escape's uri_unescape but in byte mode so we can check utf8 decoding manually
# my $txt = $data->{url};
# $txt = encode_utf8($txt); # turn OFF utf8
# $txt =~ s/%([0-9A-Fa-f]{2})/pack("C1", hex($1))/ge; # expand
# $txt = decode_utf8($txt); # turn ON utf8 where applicable
# $data->{url} = $txt;
# }
# if(defined $data->{query} && length $data->{query}) {
# URI::Escape's uri_unescape but in byte mode so we can check utf8 decoding manually
# (my $txt = $data->{query}) =~ s/%([0-9A-Fa-f]{2})/pack("C1", hex($1))/eg;
# $data->{query} = decode_utf8($txt, FB_DEFAULT);
# }
}
},
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apertur/SDK/Resource/Sessions.pm view on Meta::CPAN
use strict;
use warnings;
use JSON qw(encode_json);
use URI::Escape qw(uri_escape);
sub new {
my ($class, %args) = @_;
return bless { http => $args{http} }, $class;
}
lib/Apertur/SDK/Resource/Sessions.pm view on Meta::CPAN
sub delivery_status {
my ($self, $uuid, %opts) = @_;
my $path = "/api/v1/upload-sessions/$uuid/delivery-status";
my %req_opts;
if (defined $opts{poll_from}) {
$path .= '?pollFrom=' . uri_escape($opts{poll_from});
# Long-poll: server holds up to 5 min; give the request 6 min so the
# server releases first under the happy path.
$req_opts{timeout} = 360;
}
return $self->{http}->request('GET', $path, %req_opts);
lib/Apertur/SDK/Resource/Sessions.pm view on Meta::CPAN
sub _build_query_string {
my (%params) = @_;
my @parts;
for my $key (sort keys %params) {
next unless defined $params{$key};
push @parts, uri_escape($key) . '=' . uri_escape($params{$key});
}
return @parts ? '?' . join('&', @parts) : '';
}
1;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Apigee/Edge.pm view on Meta::CPAN
use Carp;
use Mojo::UserAgent;
use Mojo::URL;
use Mojo::Util qw(b64_encode);
use URI::Escape qw/uri_escape/;
use vars qw/$errstr/;
sub errstr { return $errstr }
sub new { ## no critic (ArgUnpacking)
lib/Apigee/Edge.pm view on Meta::CPAN
return $self->request('GET', "/o/" . $self->{org} . "/apps/$app_id");
}
sub get_apps_by_family {
my ($self, $family) = @_;
return $self->request('GET', "/o/" . $self->{org} . "/apps?appfamily=" . uri_escape($family));
}
sub get_apps_by_keystatus {
my ($self, $keystatus) = @_;
return $self->request('GET', "/o/" . $self->{org} . "/apps?keyStatus=" . uri_escape($keystatus));
}
sub get_apps_by_type {
my ($self, $type) = @_;
return $self->request('GET', "/o/" . $self->{org} . "/apps?apptype=" . uri_escape($type));
}
sub get_apps { ## no critic (ArgUnpacking)
my $self = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
lib/Apigee/Edge.pm view on Meta::CPAN
}
sub get_developer {
my $self = shift;
my ($email) = @_;
return $self->request('GET', "/o/" . $self->{org} . "/developers/" . uri_escape($email));
}
sub delete_developer {
my $self = shift;
my ($email) = @_;
return $self->request('DELETE', "/o/" . $self->{org} . "/developers/" . uri_escape($email));
}
sub get_app_developers {
my $self = shift;
my ($app) = @_;
return $self->request('GET', "/o/" . $self->{org} . "/developers?app=" . uri_escape($app));
}
sub get_developers {
my $self = shift;
return $self->request('GET', "/o/" . $self->{org} . "/developers");
}
sub set_developer_status {
my ($self, $email, $status);
return $self->request('GET', "/o/" . $self->{org} . "/developers/" . uri_escape($email) . "?action=" . uri_escape($status));
}
sub update_developer { ## no critic (ArgUnpacking)
my $self = shift;
my $email = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
$email or croak "email is required.";
return $self->request('PUT', "/o/" . $self->{org} . "/developers/" . uri_escape($email), %args);
}
## Apps: Developer http://apigee.com/docs/api/apps-developer
sub change_app_status {
my ($self, $email, $app) = @_;
return $self->request('GET', "/o/" . $self->{org} . "/developers/" . uri_escape($email) . "/apps/" . uri_escape($app));
}
sub create_developer_app { ## no critic (ArgUnpacking)
my $self = shift;
my $email = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
return $self->request('POST', "/o/" . $self->{org} . "/developers/" . uri_escape($email) . "/apps", %args);
}
sub delete_developer_app {
my ($self, $email, $app) = @_;
return $self->request('DELETE', "/o/" . $self->{org} . "/developers/" . uri_escape($email) . "/apps/" . uri_escape($app));
}
sub get_developer_app {
my ($self, $email, $app) = @_;
return $self->request('GET', "/o/" . $self->{org} . "/developers/" . uri_escape($email) . "/apps/" . uri_escape($app));
}
sub get_developer_apps { ## no critic (ArgUnpacking)
my $self = shift;
my $email = shift;
$email or croak "email is required.";
my %args = @_ % 2 ? %{$_[0]} : @_;
my $url = Mojo::URL->new("/o/" . $self->{org} . "/developers/" . uri_escape($email) . "/apps");
$url->query(\%args) if %args;
return $self->request('GET', $url->to_string);
}
sub update_developer_app { ## no critic (ArgUnpacking)
lib/Apigee/Edge.pm view on Meta::CPAN
my $email = shift;
my $app = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
$email or croak "email is required.";
$app or croak "app is required.";
return $self->request('PUT', "/o/" . $self->{org} . "/developers/" . uri_escape($email) . "/apps/" . uri_escape($app), %args);
}
sub get_count_of_developer_app_resource {
my ($self, $email, $app, $entity) = @_;
return $self->request('GET',
"/o/"
. $self->{org}
. "/developers/"
. uri_escape($email)
. "/apps/"
. uri_escape($app)
. qq~?"query=count&entity=~
. uri_escape($entity)
. qq~"~);
}
sub regenerate_developer_app_key { ## no critic (ArgUnpacking)
my $self = shift;
my $email = shift;
my $app = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
$email or croak "email is required.";
$app or croak "app is required.";
return $self->request('POST', "/o/" . $self->{org} . "/developers/" . uri_escape($email) . "/apps/" . uri_escape($app), %args);
}
## API Products http://apigee.com/docs/api/api-products-1
sub create_api_product { ## no critic (ArgUnpacking)
my $self = shift;
lib/Apigee/Edge.pm view on Meta::CPAN
sub update_api_product { ## no critic (ArgUnpacking)
my $self = shift;
my $product = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
$product or croak "product is required.";
return $self->request('PUT', "/o/" . $self->{org} . "/apiproducts/" . uri_escape($product), %args);
}
sub delete_api_product {
my ($self, $product) = @_;
return $self->request('DELETE', "/o/" . $self->{org} . "/apiproducts/" . uri_escape($product));
}
sub get_api_product {
my ($self, $product) = @_;
return $self->request('GET', "/o/" . $self->{org} . "/apiproducts/" . uri_escape($product));
}
sub get_api_products { ## no critic (ArgUnpacking)
my $self = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
lib/Apigee/Edge.pm view on Meta::CPAN
sub get_api_product_details { ## no critic (ArgUnpacking)
my $self = shift;
my $product = shift;
my %args = @_ % 2 ? %{$_[0]} : @_;
my $url = Mojo::URL->new("/o/" . $self->{org} . "/apiproducts/" . uri_escape($product));
$url->query(\%args) if %args;
return $self->request('GET', $url->to_string);
}
sub request {
lib/Apigee/Edge.pm view on Meta::CPAN
=head2 request
The underlaying method to call Apigee when you see something is missing.
$self->request('GET', "/o/$org_name/apps/$app_id");
$self->request('DELETE', "/o/$org_name/developers/" . uri_escape($email));
$self->request('POST', "/o/$org_name/developers", %args);
$self->request('PUT', "/o/$org_name/developers/" . uri_escape($email), %args);
=head2 errstr
=head1 GITHUB
view all matches for this distribution
view release on metacpan or search on metacpan
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
DEFSV|5.004005|5.003007|p
DEFSV_set|5.010001|5.003007|p
del_body_by_type|||Viu
delete_eval_scope|5.009004||xViu
delimcpy|5.004000|5.004000|n
delimcpy_no_escape|5.025005||cVni
DEL_NATIVE|5.017010||Viu
del_sv|5.005000||Viu
DEPENDS_PAT_MOD|5.013009||Viu
DEPENDS_PAT_MODS|5.013009||Viu
deprecate|5.011001||Viu
putc_unlocked|5.003007||Viu
putenv|5.005000||Viu
put_range|5.019009||Viu
putw|5.003007||Viu
pv_display|5.006000|5.003007|p
pv_escape|5.009004|5.003007|p
pv_pretty|5.009004|5.003007|p
pv_uni_display|5.007003|5.007003|
pWARN_ALL|5.006000||Viu
pWARN_NONE|5.006000||Viu
pWARN_STD|5.006000||Viu
#ifndef PERL_PV_PRETTY_REGPROP
# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
#endif
/* Hint: pv_escape
* Note that unicode functionality is only backported to
* those perl versions that support it. For older perl
* versions, the implementation will fall back to bytes.
*/
#ifndef pv_escape
#if defined(NEED_pv_escape)
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
static
#else
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
#endif
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
#ifdef pv_escape
# undef pv_escape
#endif
#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
#define Perl_pv_escape DPPP_(my_pv_escape)
char *
DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
const STRLEN count, const STRLEN max,
STRLEN * const escaped, const U32 flags)
{
const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
char octbuf[32] = "%123456789ABCDF";
STRLEN wrote = 0;
wrote++;
}
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
break;
}
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
sv_catpvs(dsv, "...");
return SvPVX(dsv);
}
view all matches for this distribution
view release on metacpan or search on metacpan
script/rgb-to-ansi-bg-code view on Meta::CPAN
read_env => 0,
);
$cmdline->run;
# ABSTRACT: Convert RGB to ANSI color escape sequence to change background color
# PODNAME: rgb-to-ansi-bg-code
__END__
=pod
=encoding UTF-8
=head1 NAME
rgb-to-ansi-bg-code - Convert RGB to ANSI color escape sequence to change background color
=head1 VERSION
This document describes version 0.011 of rgb-to-ansi-bg-code (from Perl distribution App-ANSIColorUtils), released on 2025-03-18.
view all matches for this distribution
view release on metacpan or search on metacpan
script/_acme-cpanauthors view on Meta::CPAN
# my ($word, $is_cur_word, $after_ws) = @_;
#
# #say "D:add_unquoted word=$word is_cur_word=$is_cur_word after_ws=$after_ws";
#
# $word =~ s!^(~)(\w*)(/|\z) | # 1) tilde 2) username 3) optional slash
# \\(.) | # 4) escaped char
# \$(\w+) # 5) variable name
# !
# $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
# $4 ? $4 :
# ($is_cur_word ? "\$$5" : $ENV{$5})
script/_acme-cpanauthors view on Meta::CPAN
#sub _add_double_quoted {
# no warnings 'uninitialized';
#
# my ($word, $is_cur_word) = @_;
#
# $word =~ s!\\(.) | # 1) escaped char
# \$(\w+) # 2) variable name
# !
# $1 ? $1 :
# ($is_cur_word ? "\$$2" : $ENV{$2})
# !egx;
script/_acme-cpanauthors view on Meta::CPAN
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
# quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
# parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
# bash would split it as (represented as Perl):
script/_acme-cpanauthors view on Meta::CPAN
# # add things to words, etc
# local point=... # calculate the new point
# COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
# }
#
# To avoid these word-breaking characters to be split/grouped, we can escape
# them with backslash or quote them, e.g.:
#
# command "http://example.com:80" Foo\:\:Bar
#
# which bash will parse as:
script/_acme-cpanauthors view on Meta::CPAN
# v => 1.1,
# summary => 'Format completion for output (for shell)',
# description => <<'_',
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the `Complete`
#POD. Aside from `words`, this function also recognizes these keys:
#
script/_acme-cpanauthors view on Meta::CPAN
# array.
#
#* esc_mode
#
# Escaping mode for entries. Either `default` (most nonalphanumeric characters
# will be escaped), `shellvar` (like `default`, but dollar sign `$` will also be
# escaped, convenient when completing environment variables for example),
# `filename` (currently equals to `default`), `option` (currently equals to
# `default`), or `none` (no escaping will be done).
#
#* word
#
script/_acme-cpanauthors view on Meta::CPAN
# ESCAPE_WORDS:
# for my $entry (@$words) {
# my $word = ref($entry) eq 'HASH' ? $entry->{word} : $entry;
# my $summary = (ref($entry) eq 'HASH' ? $entry->{summary} : undef) // '';
# if ($esc_mode eq 'shellvar') {
# # escape $ also
# $word =~ s!([^A-Za-z0-9,+._/:~-])!\\$1!g;
# } elsif ($esc_mode eq 'none') {
# # no escaping
# } else {
# # default
script/_acme-cpanauthors view on Meta::CPAN
# format_completion($completion, $opts) -> str|array
#
#Format completion for output (for shell).
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the C<Complete>
#POD. Aside from C<words>, this function also recognizes these keys:
#
script/_acme-cpanauthors view on Meta::CPAN
#array.
#
#=item * esc_mode
#
#Escaping mode for entries. Either C<default> (most nonalphanumeric characters
#will be escaped), C<shellvar> (like C<default>, but dollar sign C<$> will also be
#escaped, convenient when completing environment variables for example),
#C<filename> (currently equals to C<default>), C<option> (currently equals to
#C<default>), or C<none> (no escaping will be done).
#
#=item * word
#
script/_acme-cpanauthors view on Meta::CPAN
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's C<COMP_WORDS> contains all the
# quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
# parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
# bash would split it as (represented as Perl):
script/_acme-cpanauthors view on Meta::CPAN
# # add things to words, etc
# local point=... # calculate the new point
# COMPREPLY=( C<COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo> )
#}
#
#To avoid these word-breaking characters to be split/grouped, we can escape
#them with backslash or quote them, e.g.:
#
#command "http://example.com:80" Foo\:\:Bar
#
#which bash will parse as:
script/_acme-cpanauthors view on Meta::CPAN
# modify_answer(answer=>$fres, suffix=>"=");
# $fres->{path_sep} = "=";
# # XXX actually not entirely correct, we want normal
# # escaping but without escaping "=", maybe we should
# # allow customizing, e.g. esc_mode=normal, dont_esc="="
# # (list of characters to not escape)
# $fres->{esc_mode} = "none";
# goto RETURN_RES;
# }
# } else {
# $fres = complete_arg_val(
script/_acme-cpanauthors view on Meta::CPAN
# )x;
#
## note: order is important here, brace encloses the other
#our $RE_WILDCARD_BASH =
# qr(
# # non-escaped brace expression, with at least one comma
# (?P<bash_brace>
# (?<!\\)(?P<slashes_before_bash_brace>\\\\)*\{
# (?P<bash_brace_content>
# $re_bash_brace_element(?:, $re_bash_brace_element )+
# )
# (?<!\\)(?:\\\\)*\}
# )
# |
# # non-escaped brace expression, to catch * or ? or [...] inside so
# # they don't go to below pattern, because bash doesn't consider them
# # wildcards, e.g. '/{et?,us*}' expands to '/etc /usr', but '/{et?}'
# # doesn't expand at all to /etc.
# (?P<literal_brace_single_element>
# (?<!\\)(?:\\\\)*\{
# $re_bash_brace_element
# (?<!\\)(?:\\\\)*\}
# )
# |
# (?P<bash_class>
# # non-empty, non-escaped character class
# (?<!\\)(?:\\\\)*\[
# (?: \\\\ | \\\[ | \\\] | [^\\\[\]] )+
# (?<!\\)(?:\\\\)*\]
# )
# |
# (?P<bash_joker>
# # non-escaped * and ?
# (?<!\\)(?:\\\\)*(?:\*\*?|\?)
# )
# |
# (?P<sql_joker>
# # non-escaped % and ?
# (?<!\\)(?:\\\\)*[%_]
# )
# |
# (?P<literal>
# [^\\\[\]\{\}*?%_]+
script/_acme-cpanauthors view on Meta::CPAN
# }
#
# } elsif (defined($p = $m{literal_brace_single_element})) {
# push @res, quotemeta($p);
# } elsif (defined($p = $m{bash_class})) {
# # XXX no need to escape some characters?
# push @res, $p;
# } elsif (defined($p = $m{sql_joker})) {
# push @res, quotemeta($p);
# } elsif (defined($p = $m{literal})) {
# push @res, quotemeta($p);
script/_acme-cpanauthors view on Meta::CPAN
# $bool = contains_wildcard($wildcard_str)
#
#Return true if C<$str> contains wildcard pattern. Wildcard patterns include
#I<joker> such as C<*> (meaning zero or more of any characters) and C<?> (exactly
#one of any character), I<character class> C<[...]>, and I<brace> C<{...,}>
#(brace expansion). A pattern can be escaped using a bacslash so it becomes
#literal, e.g. C<foo\*> does not contain wildcard because it's C<foo> followed by
#a literal asterisk C<*>.
#
#Aside from the abovementioned wildcard patterns, bash does other types of
#expansions/substitutions too, but these are not considered wildcard. These
script/_acme-cpanauthors view on Meta::CPAN
#
#Convert bash wildcard to SQL pattern. This includes:
#
#=over
#
#=item * converting unescaped C<*> to C<%>
#
#=item * converting unescaped C<?> to C<_>
#
#=item * escaping unescaped C<%>
#
#=item * escaping unescaped C<_>
#
#=back
#
#Unsupported constructs will cause the function to die.
#
view all matches for this distribution
view release on metacpan or search on metacpan
lib/App/Adenosine.pm view on Meta::CPAN
# ABSTRACT: Handy CLI HTTP tool
use URI;
use Getopt::Long qw(:config pass_through no_ignore_case);
use File::Path 'mkpath';
use URI::Escape 'uri_escape';
use File::Spec::Functions 'splitpath';
use Path::Class;
use Text::ParseWords;
use Scalar::Util 'blessed';
use Module::Runtime 'use_module';
lib/App/Adenosine.pm view on Meta::CPAN
push @extra, '-I' if $action eq 'HEAD';
my $_path = $uri_base;
$_path =~ s/\*/$path/;
$query = uri_escape($query) if $quote;
push @extra, $self->host_method_config( $self->host($uri_base), $action );
$query = "?$query" if $query;
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/MojoX/Aliyun.pm view on Meta::CPAN
);
# say Dumper(\%auth_params); use Data::Dumper;
# Thanks to https://github.com/lemontv/AliyunPerlLib/blob/master/Aliyun/Auth.pm
my %dumb = %auth_params; $dumb{Timestamp} = uri_escape($dumb{Timestamp});
my @tmps = map { join('=', $_, $dumb{$_}) } sort keys(%dumb);
my $StringToSign = join("&", @tmps);
$StringToSign = join('&', $method, uri_escape($path), uri_escape($StringToSign));
my $Signature = hmac_sha1_base64($StringToSign, $self->access_secret . '&');
$auth_params{Signature} = $Signature . '=';
my $tx = $self->ua->build_tx($method => $url => form => \%auth_params );
$tx = $self->ua->start($tx);
view all matches for this distribution
view release on metacpan or search on metacpan
lib/App/AltSQL.pm view on Meta::CPAN
The hostname the model is connected to
=item B<%%>
An escaped percent sign
=item B<%c{...}>
A L<Term::ANSIColor> color name. The value will be passed directly to the C<color> method.
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/App/ArduinoBuilder/System.pm view on Meta::CPAN
# Splits a given command line string into individual arguments.
# Returns the array of individual arguments.
#
# This approach is very primitive. However both Parse::CommandLine and
# Text::ParseWords have the same issue that they consider that a backslash can
# escape any character, which is wrong on Windows (C:\foo is not C:foo).
# Also Text::Balanced, is not well suited for this case where we can have
# unquoted pieces of text.
#
# Ideally, we would use whatever Perl uses to split a command into word as
# per https://perldoc.perl.org/functions/exec, but this does not seem to be
# exposed
#
# TODO: support escaped quotes (that are not quoting arguments) as well as,
# maybe, quotes interrupting unquoted arguments.
sub split_cmd {
my ($cmd) = @_;
my @cmd;
while ($cmd =~ m/ \G \s* (?: (['"])(?<p>.*?)\1 | (?<p>[^ ]+) ) /gx) {
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
inc/Module/Install/Metadata.pm view on Meta::CPAN
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
view all matches for this distribution