Result:
found more than 655 distributions - search limited to the first 2001 files matching your query
( run in 0.498 )
AAAA-Crypt-DH
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 {
ACME-QuoteDB
view release on metacpan or search on metacpan
lib/ACME/QuoteDB.pm view on Meta::CPAN
$attr_name = q/ attr_id IS NOT NULL /;
$ids = [];
}
if ($source) {
$source =~ s{'}{''}gsm; # sql escape single quote
$source = qq/ AND source = '$source' /;
}
my $qids = q{};
if ($catgs) {
$catgs = _get_ids_if_catgs_exist($catgs);
ADAMK-Release
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 {
AES128
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
put_charclass_bitmap_innards_invlist|||
put_charclass_bitmap_innards|||
put_code_point|||
put_range|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
quadmath_format_needed|||n
#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);
}
AFS-Command
view release on metacpan or search on metacpan
This module requires perl5.6 or later, as well as an installed AFS
infrastructure to work with. The code is pure perl, with no compiled
components, do it should work on any variant of UNIX (sorry, but this
code makes aggressive use of pipe() and fork(), so porting it to
Windows is gonna be painful... but then, why anyone would want to
manage their AFS infrastructure from Windows escapes me).
=head1 INSTALLATION
This module builds like almost everything else on CPAN:
AFS
view release on metacpan or search on metacpan
src/ppport.h view on Meta::CPAN
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
src/ppport.h view on Meta::CPAN
ptr_table_store||5.009005|
push_scope|||
put_byte|||
put_latin1_charclass_innards|||
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|
src/ppport.h view on Meta::CPAN
#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;
src/ppport.h view on Meta::CPAN
wrote++;
}
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
break;
}
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
src/ppport.h view on Meta::CPAN
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 == '"')
src/ppport.h view on Meta::CPAN
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);
}
AI-FANN
view release on metacpan or search on metacpan
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_byte|||
pv_display||5.006000|
pv_escape||5.009004|
pv_pretty||5.009004|
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
AI-MegaHAL
view release on metacpan or search on metacpan
megahal.trn view on Meta::CPAN
A barber is someone who shaves and cuts the hair of a client for business.
A bard was a Celtic poet.
Beethoven was a German composer.
Benjamin Franklin was an American statesman and scientist.
Bruce Lee was a Chinese actor and expert in Kung Fu who popularised the martial arts in the west.
Bushrangers were Australian highwaymen, formerly escaped convicts.
Captain James Cook was an English sailor and explorer.
Charles Babbage was a British mathematician. He designed an analytical engine which was the forerunner of the modern computer.
Charles Robert Darwin was an English naturalist. He published his theory of evolution in a book entitled The Origin of Species.
A cretin is someone who suffers from the disease cretinism.
The druids were ancient Celtic priests. Their group still exists today in secret, despite the existence of charlatan groups claiming to be druids.
AI-MicroStructure
view release on metacpan or search on metacpan
bin/micro-wiki view on Meta::CPAN
use HTML::Strip;
use AI::MicroStructure::Util;
use WWW::Wikipedia;
use LWP::UserAgent;
use HTML::SimpleLinkExtor;
use URI::Escape qw( uri_unescape );
our $e = HTML::SimpleLinkExtor->new;
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';
bin/micro-wiki view on Meta::CPAN
$theURL =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
return $theURL;
}
sub smartdecode {
use URI::Escape qw( uri_unescape );
use utf8;
my $x = my $y = uri_unescape($_[0]);
return $x if utf8::decode($x);
return $y;
}
sub imgTranslate {
AI-Pathfinding-AStar-Rectangle
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);
}
AI-Prolog
view release on metacpan or search on metacpan
data/sleepy.pro view on Meta::CPAN
/* Have flyswatter, room is lit, fly is here and alive. */
swat :-
buzz_off,
print('The fly escapes into the other room.'), nl.
swat :-
print('Success! You killed that pesky fly!'), nl,
retract(alive(fly)).
AI-TensorFlow-Libtensorflow
view release on metacpan or search on metacpan
lib/AI/TensorFlow/Libtensorflow/Status.pm view on Meta::CPAN
my ($self, $ddp) = @_;
if( $self->GetCode != AI::TensorFlow::Libtensorflow::Status::OK() ) {
return sprintf('%s %s %s %s%s%s %s',
$ddp->maybe_colorize( ref($self), 'class' ),
$ddp->maybe_colorize( '{', 'brackets' ),
$ddp->maybe_colorize( $_TF_CODE_INT_TO_NAME{$self->GetCode}, 'escaped' ),
$ddp->maybe_colorize( '(', 'brackets' ),
$ddp->maybe_colorize( $self->Message, 'string' ),
$ddp->maybe_colorize( ')', 'brackets' ),
$ddp->maybe_colorize( '}', 'brackets' ),
);
} else {
return sprintf('%s %s %s %s',
$ddp->maybe_colorize( ref($self), 'class' ),
$ddp->maybe_colorize( '{', 'brackets' ),
$ddp->maybe_colorize( $_TF_CODE_INT_TO_NAME{$self->GetCode}, 'escaped' ),
$ddp->maybe_colorize( '}', 'brackets' ),
);
}
}
ALPM
view release on metacpan or search on metacpan
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_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);
}
APISchema
view release on metacpan or search on metacpan
lib/APISchema/Generator/Markdown.pm view on Meta::CPAN
sub new {
my ($class) = @_;
my $renderer = Text::MicroTemplate::DataSection->new(
escape_func => undef
);
bless {
renderer => $renderer,
map {
( $_ => $renderer->build_file($_) );
APR-Emulate-PSGI
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 {
ARGV-Struct
view release on metacpan or search on metacpan
lib/ARGV/Struct.pm view on Meta::CPAN
deeply nested arguments, or datastructure-like information. Here are some strategies that
I've found over time:
=head2 Complex arguments codified as JSON
JSON is horrible for the command line because you have to escape the quotes. It's a nightmare.
command --complex_arg "{\"key1\":\"value1\",\"key2\":\"value2\"}"
=head2 Arguments encoded via some custom scheme
ARSObject
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
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;
lib/ARSObject.pm view on Meta::CPAN
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;
lib/ARSObject.pm view on Meta::CPAN
)
}
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 .'"');
}
lib/ARSObject.pm view on Meta::CPAN
}
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
}
lib/ARSObject.pm view on Meta::CPAN
? (-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}->{$_})
lib/ARSObject.pm view on Meta::CPAN
))
)
}
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=>{}
lib/ARSObject.pm view on Meta::CPAN
,'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
: 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;
lib/ARSObject.pm view on Meta::CPAN
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 ='';
lib/ARSObject.pm view on Meta::CPAN
: 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}
ASNMTAP
view release on metacpan or search on metacpan
lib/ASNMTAP/Asnmtap/Applications.pm view on Meta::CPAN
var ca = document.cookie.split( ';' );
for( var i=0; i < ca.length; i++ ) {
var c = ca[i];
while ( c.charAt( 0 ) == ' ' ) c = c.substring( 1, c.length );
if ( c.indexOf( prefix ) == 0 ) return unescape( c.substring( prefix.length, c.length ) );
}
return null;
}
lib/ASNMTAP/Asnmtap/Applications.pm view on Meta::CPAN
if ( days ) {
(time = new Date()).setTime( new Date().getTime() + days * 24 * 60 * 60 * 1000);
expires = "; expires=" + time.toGMTString();
}
document.cookie = name + "=" + escape(value) + expires + "; path=/";
}
function loadEnvironmentPageDirCookie ( pageDir, environment ) {
var name = 'pagedir_id_' + pageDir + '_' + environment;
var url = '$HTTPSURL/nav/' + pageDir + '/';
lib/ASNMTAP/Asnmtap/Applications.pm view on Meta::CPAN
if ( days ) {
(time = new Date()).setTime( new Date().getTime() + days * 24 * 60 * 60 * 1000);
expires = "; expires=" + time.toGMTString();
}
document.cookie = name + "=" + escape(value) + expires + "; path=$HTTPSURL/nav/";
}
function getSoundCookie( name ) {
var prefix = name + '=';
var ca = document.cookie.split( ';' );
for( var i=0; i < ca.length; i++ ) {
var c = ca[i];
while ( c.charAt( 0 ) == ' ' ) c = c.substring( 1, c.length );
if ( c.indexOf( prefix ) == 0 ) return unescape( c.substring( prefix.length, c.length ) );
}
return null;
}
lib/ASNMTAP/Asnmtap/Applications.pm view on Meta::CPAN
var ca = document.cookie.split( ';' );
for( var i=0; i < ca.length; i++ ) {
var c = ca[i];
while ( c.charAt( 0 ) == ' ' ) c = c.substring( 1, c.length );
if ( c.indexOf( prefix ) == 0 ) return unescape( c.substring( prefix.length, c.length ) );
}
return null;
}
lib/ASNMTAP/Asnmtap/Applications.pm view on Meta::CPAN
if ( days ) {
(time = new Date()).setTime( new Date().getTime() + days * 24 * 60 * 60 * 1000);
expires = "; expires=" + time.toGMTString();
}
document.cookie = name + "=" + escape(value) + expires + "; path=/";
}
function loadEnvironmentPageDirCookie ( pageDir, environment ) {
var name = 'pagedir_id_' + pageDir + '_' + environment;
var url = '$HTTPSURL/nav/' + pageDir + '/';
lib/ASNMTAP/Asnmtap/Applications.pm view on Meta::CPAN
$dbh->{csv_tables}{$tableName} = { file => $tableFilename };
$dbh->{csv_null} = 1;
$dbh->{csv_allow_whitespace} = 0;
$dbh->{csv_allow_loose_quotes} = 0;
$dbh->{csv_allow_loose_escapes} = 0;
$dbh->{csv_eol} = $\;
$dbh->{csv_sep_char} = ',';
$dbh->{csv_quote_char} = '"';
$dbh->{csv_escape_char} = '"';
if ( -e "$path$tableFilename$extention" ) {
@{$columnSequence} = ();
use Text::CSV;
ASP
view release on metacpan or search on metacpan
Print Warn die exit param param_count
$Application $ObjectContext $Request
$Response $Server $Session
$ScriptingNamespace
DebugPrint HTMLPrint
escape unescape escapeHTML unescapeHTML
)],
);
Exporter::export_tags('basic');
Exporter::export_ok_tags('all');
_END;
$main::Response->End();
CORE::exit();
}
=head2 escape LIST
Escapes (URL-encodes) a list. Uses ASP object method
$Server->URLEncode().
=cut
sub escape { map { $main::Server->URLEncode($_) } @_; }
=head2 unescape LIST
Unescapes a URL-encoded list. Algorithms ripped from CGI.pm
method of the same name.
=cut
sub unescape {
map {
tr/+/ /;
s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
} @_;
}
=head2 escapeHTML LIST
Escapes a list of HTML. Uses ASP object method $Server->HTMLEncode().
If passed an array reference, escapeHTML will return a reference
to the escaped array.
=cut
sub escapeHTML {
my ($flag, @args) = (0, @_);
@args = @{$args[0]} and $flag++ if ref $args[0] eq "ARRAY";
$_ = $main::Server->HTMLEncode($_) for @args;
$flag ? \@args : @args;
}
=head2 unescapeHTML LIST
Unescapes an HTML-encoded list.
If passed an array reference, unescapeHTML will return a reference
to the un-escaped array.
=cut
sub unescapeHTML {
my ($flag, @args) = (0, @_);
@args = @{$args[0]} and $flag++ if ref $args[0] eq "ARRAY";
map {
s/&/&/gi;
s/"/"/gi;
Removed BinaryWrite(), SetCookie(), and Autoload functionality.
=item Version 1.00
The escapeHTML() and unescapeHTML() functions now accept array refs as well
as lists, as Win32::ASP::HTMLEncode() was supposed to.
Thanks to Matt Sergeant for the fix.
=item Version 0.97
Overloaded warn() and subsequently removed prototypes.
Exported $ScriptingNamespace object.
Added methods escape(), unescape(), escapeHTML(), unescapeHTML().
Thanks to Bill Odom for pointing these out!
Re-implemented SetCookie and BinaryWrite functions.
=item Version 0.11
ASP4-PSGI
view release on metacpan or search on metacpan
lib/ASP4/PSGI.pm view on Meta::CPAN
my $api = ASP4::API->new();
# Parse cookies:
foreach my $cookie ( split /;\s*/, ($ENV{HTTP_COOKIE}||'') )
{
my ($k,$v) = map { ASP4::SimpleCGI->unescape($_) } split /\=/, $cookie;
$api->ua->add_cookie( $k => $v );
}# end foreach()
# Execute the request:
my $method = lc( $ENV{REQUEST_METHOD} );
ASP4
view release on metacpan or search on metacpan
lib/ASP4/Request.pm view on Meta::CPAN
form => {
(
map {
# CGI->Vars joins multi-value params with a null byte. Which sucks.
# To avoid that behavior, we do this instead:
my @val = map { $cgi->unescape( $_ ) } ( $cgi->param($_) );
$cgi->unescape($_) => scalar(@val) > 1 ? \@val : shift(@val)
} $cgi->param
),
(
map {
# CGI->Vars joins multi-value params with a null byte. Which sucks.
# To avoid that behavior, we do this instead:
my @val = map { $cgi->unescape( $_ ) } ( $cgi->url_param($_) );
$cgi->unescape($_) => scalar(@val) > 1 ? \@val : shift(@val)
} $cgi->url_param
),
},
}, $class;
lib/ASP4/Request.pm view on Meta::CPAN
my $cgi = $s->context->cgi;
my $Form = $s->context->request->Form;
map {
my ($k,$v) = split /\=/, $_;
$Form->{ $cgi->unescape($k) } = $cgi->unescape( $v );
} split /&/, $querystring;
( my $path = $s->context->server->MapPath( $uri ) ) =~ s{/+$}{};
$path .= "/index.asp" if -f "$path/index.asp";
$ENV{SCRIPT_FILENAME} = $path;
AUBBC
view release on metacpan or search on metacpan
smileys => 1,
highlight => 1,
highlight_function => \&code_highlight,
no_bypass => 0,
for_links => 0,
aubbc_escape => 1,
no_img => 0,
icon_image => 1,
image_hight => '60',
image_width => '90',
image_border => '0',
code_extra => '',
code_download => '^Download above code^',
href_class => '',
quote_class => '',
quote_extra => '',
script_escape => 1,
protect_email => '0',
email_message => 'Contact Email',
highlight_class1 => '',
highlight_class2 => '',
highlight_class3 => '',
unless ($@ || ! defined $Memoize::VERSION) {
Memoize::memoize('AUBBC::settings');
Memoize::memoize('AUBBC::smiley_hash');
Memoize::memoize('AUBBC::add_build_tag');
Memoize::memoize('AUBBC::do_all_ubbc');
Memoize::memoize('AUBBC::script_escape');
Memoize::memoize('AUBBC::html_to_text');
}
$aubbc_error .= $@."\n" if $@;
}
return bless {};
my ($self,$message) = @_;
warn 'ENTER do_all_ubbc' if $DEBUG_AUBBC;
$msg = defined $message ? $message : '';
if ($msg) {
check_access();
$msg = $self->script_escape($msg,'') if $AUBBC{script_escape};
$msg =~ s/&(?!\#?\w+;)/&/g if $AUBBC{fix_amp};
if (!$AUBBC{no_bypass} && $msg =~ m/\A\#no/) {
$do_f[4] = 0 if $msg =~ s/\A\#none//;
if ($do_f[4]) {
$do_f[0] = 0 if $msg =~ s/\A\#noubbc//;
$do_f[3] = 0 if $msg =~ s/\A\#nosmileys//;
}
warn 'START no_bypass' if $DEBUG_AUBBC && !$do_f[4];
}
if ($do_f[4]) {
escape_aubbc() if $AUBBC{aubbc_escape};
if (!$AUBBC{for_links}) {
do_ubbc($msg) if $do_f[0] && $AUBBC{aubbc};
do_build_tag() if $do_f[5] && $do_f[1];
}
do_unicode() if $do_f[2] && $AUBBC{utf};
do_smileys() if $do_f[6] && $do_f[3] && $AUBBC{smileys};
}
}
$msg =~ tr/\000//d if $AUBBC{aubbc_escape};
return $msg;
}
sub fix_message {
my $txt = shift;
$txt =~ s/\././g;
$txt =~ s/\:/:/g;
return $txt;
}
sub escape_aubbc {
warn 'ENTER escape_aubbc' if $DEBUG_AUBBC;
$msg =~ s/\[\[/\000[/g;
$msg =~ s/\]\]/\000]/g;
}
sub script_escape {
my ($self, $text, $option) = @_;
warn 'ENTER html_escape' if $DEBUG_AUBBC;
$text = '' unless defined $text;
if ($text) {
$text =~ s/(&|;)/$1 eq '&' ? '&' : ';'/ge;
if (!$option) {
$text =~ s/\t/ \ \ \ /g;
Most sites that use these tags show a list of them and/or easy way to insert the tags to the form field by the user.
The [c] or code tags can highlight Perl code, highlighting the Perl code with CSS in HTML/XHTML,
and in the examples folder the tag_list.cgi file has a CSS code you could work from and now a setting to change to a costume highlighter function.
This module addresses many security issues the BBcode tags may have mainly cross site script also known as XSS.
Each message is escaped before it gets returned if script_escape is Enabled and checked for many types of security problems before that tag converts to HTML/XHTML.
The script_escape setting and method also converts the ' sign so the text can be stored in a SQL back-end.
Most of the free web portals use the | sign as the delimiter for the flat file database, the script_escape setting and method also converts that sign so the structure of the database is retained.
Allows easy conversion to HTML and XHTML, existing tags will convert to the HTML type set.
If there isn't a popular tag available this module provides a method to "Build your own tags" custom tags can help link to parts of the current web page, other web pages and add other HTML elements.
AVLTree
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);
}
AWS-CloudFront
view release on metacpan or search on metacpan
lib/AWS/CloudFront/Signer.pm view on Meta::CPAN
use VSO;
use HTTP::Request::Common;
use HTTP::Date 'time2str';
use MIME::Base64 qw(encode_base64);
use URI::Escape qw(uri_escape_utf8);
use URI::QueryParam;
use URI::Escape;
use URI;
use Digest::HMAC_SHA1 'hmac_sha1';
use Digest::MD5 'md5';
lib/AWS/CloudFront/Signer.pm view on Meta::CPAN
sub _urlencode
{
my ($unencoded ) = @_;
return uri_escape_utf8( $unencoded, '^A-Za-z0-9_-' );
}# end _urlencode()
1;# return true:
AWS-Lambda
view release on metacpan or search on metacpan
examples/s3-get-object/handler.pl view on Meta::CPAN
sub handle {
my $payload = shift;
# Get the object from the event and show its content type
my $bucket = $payload->{Records}[0]{s3}{bucket}{name};
my $key = uri_unescape($payload->{Records}[0]{s3}{object}{key} =~ s/\+/ /gr);
my $resp = try {
$obj->GetObject(
Bucket => $bucket,
Key => $key,
);
AWS-S3
view release on metacpan or search on metacpan
lib/AWS/S3/Request/GetPreSignedUrl.pm view on Meta::CPAN
package AWS::S3::Request::GetPreSignedUrl;
use Moose;
use AWS::S3::Signer;
use URI::Escape qw(uri_escape);
with 'AWS::S3::Roles::Request';
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
AWS-SQS-Simple
view release on metacpan or search on metacpan
lib/AWS/SQS/Simple.pm view on Meta::CPAN
my $url_additional_str = $self->{ AWS_ACCOUNT_ID } . '/' . delete( $params->{ QUEUE_NAME } ) ;
my $sign_query = _get_signed_query( $params ) ;
my $to_escape = qr{^(?:Signature|MessageBody|ReceiptHandle)|\.\d+\.(?:MessageBody|ReceiptHandle)$} ;
foreach my $key( keys %$params ) {
next unless $key =~ m/$to_escape/ ;
next unless exists $params->{ $key } ;
my $octets = encode( 'utf-8-strict', $params->{ $key } ) ;
$params->{ $key } = escape( $octets ) ;
}
my $uri_str = join('&', map { $_ . '=' . $params->{$_} } keys %$params ) ;
lib/AWS/SQS/Simple.pm view on Meta::CPAN
$sign_str .= "\n" . $sign_query ;
my $signature = $self->_generate_signatue( $sign_str ) ;
$uri_str .= '&Signature=' . escape( $signature ) ;
my $url = "http://".$self->{ END_POINT } ;
$url .= '/' . $url_additional_str . '/' if( $params->{ Action } ne "CreateQueue" ) ;
$url .= '?' . $uri_str ;
lib/AWS/SQS/Simple.pm view on Meta::CPAN
return $digest ;
}
=head2 _get_signed_query
This function utf8 encodes and uri escapes the parameters passed to generate the signed string.
=cut
sub _get_signed_query {
lib/AWS/SQS/Simple.pm view on Meta::CPAN
$to_sign .= '&' if $to_sign ;
my $key_octets = encode('utf-8-strict', $key ) ;
my $value_octets = encode('utf-8-strict', $params->{ $key } ) ;
$to_sign .= escape( $key_octets ) . '=' . escape( $value_octets ) ;
}
return $to_sign ;
}
=head2 escape
URI escape only the characters that should be escaped, according to RFC 3986
=cut
sub escape {
my ($str) = @_;
return uri_escape_utf8( $str,'^A-Za-z0-9\-_.~' ) ;
}
=head2 _generate_timestamp
Calculate current TimeStamp
AWS-Signature-V2
view release on metacpan or search on metacpan
lib/AWS/Signature/V2.pm view on Meta::CPAN
sub _build_aws_secret_key { $ENV{AWS_SECRET_KEY} }
sub sign {
my ($self, $url) = @_;
my %eq = map { split /=/, $_ } split /&/, $url->query();
my %q = map { $_ => decode_utf8( uri_unescape( $eq{$_} ) ) } keys %eq;
$q{Keywords} =~ s/\+/ /g if $q{Keywords};
$q{AWSAccessKeyId} = $self->aws_access_key;
$q{Timestamp} ||= do {
my ( $ss, $mm, $hh, $dd, $mo, $yy ) = gmtime();
join '',
sprintf( '%04d-%02d-%02d', $yy + 1900, $mo + 1, $dd ), 'T',
sprintf( '%02d:%02d:%02d', $hh, $mm, $ss ), 'Z';
};
$q{Version} ||= '2010-09-01';
my $sq = join '&',
map { $_ . '=' . uri_escape_utf8( $q{$_}, "^A-Za-z0-9\-_.~" ) }
sort keys %q;
my $tosign = join "\n", 'GET', $url->host, $url->path, $sq;
my $signature = hmac_sha256_base64( $tosign, $self->aws_secret_key );
$signature .= '=' while length($signature) % 4; # padding required
$q{Signature} = $signature;
lib/AWS/Signature/V2.pm view on Meta::CPAN
}
sub signature {
my ($self, $url) = @_;
my %eq = map { split /=/, $_ } split /&/, $url->query();
my %q = map { $_ => uri_unescape( $eq{$_} ) } keys %eq;
$q{Signature};
}
1;
AWS-Signature4
view release on metacpan or search on metacpan
lib/AWS/Signature4.pm view on Meta::CPAN
$hashed_payload ||= sha256_hex($request->content);
# canonicalize query string
my %canonical;
while (my ($key,$value) = splice(@params,0,2)) {
$key = uri_escape($key);
$value = uri_escape($value);
push @{$canonical{$key}},$value;
}
my $canonical_query_string = join '&',map {my $key = $_; map {"$key=$_"} sort @{$canonical{$key}}} sort keys %canonical;
# canonicalize the request headers
( run in 0.498 second using v1.01-cache-2.11-cpan-b888b73be4d )