—package
Mojo::Util;
use
Mojo::Base -strict;
use
Data::Dumper ();
use
IO::Compress::Gzip;
use
Time::HiRes ();
use
Unicode::Normalize ();
# Encryption support requires CryptX 0.080+
CryptX->VERSION(
'0.080'
);
1;
});
# Check for monotonic clock support
# Punycode bootstring parameters
use
constant {
PC_BASE
=> 36,
PC_TMIN
=> 1,
PC_TMAX
=> 26,
PC_SKEW
=> 38,
PC_DAMP
=> 700,
PC_INITIAL_BIAS
=> 72,
PC_INITIAL_N
=> 128
};
# To generate a new HTML entity table run this command
# perl examples/entities.pl > lib/Mojo/resources/html_entities.txt
my
%ENTITIES
;
{
# Don't use Mojo::File here due to circular dependencies
my
$path
= File::Spec->catfile(dirname(__FILE__),
'resources'
,
'html_entities.txt'
);
open
my
$file
,
'<'
,
$path
or croak
"Unable to open html entities file ($path): $!"
;
my
$lines
=
do
{
local
$/; <
$file
> };
for
my
$line
(
split
/\n/,
$lines
) {
next
unless
$line
=~ /^(\S+)\s+U\+(\S+)(?:\s+U\+(\S+))?/;
$ENTITIES
{$1} =
defined
$3 ? (
chr
(
hex
$2) .
chr
(
hex
$3)) :
chr
(
hex
$2);
}
}
# Characters that should be escaped in XML
my
%XML
= (
'&'
=>
'&'
,
'<'
=>
'<'
,
'>'
=>
'>'
,
'"'
=>
'"'
,
'\''
=>
'''
);
# "Sun, 06 Nov 1994 08:49:37 GMT" and "Sunday, 06-Nov-94 08:49:37 GMT"
my
$EXPIRES_RE
=
qr/(\w+\W+\d+\W+\w+\W+\d+\W+\d+:\d+:\d+\W*\w+)/
;
# Header key/value pairs
my
$QUOTED_VALUE_RE
=
qr/\G=\s*("(?:\\\\|\\"|[^"])*")/
;
my
$UNQUOTED_VALUE_RE
=
qr/\G=\s*([^;, ]*)/
;
# HTML entities
my
$ENTITY_RE
=
qr/&(?:\#((?:[0-9]{1,7}|x[0-9a-fA-F]{1,6}));|(\w+[;=]?))/
;
# Encoding, encryption and pattern caches
my
(
%ENCODING
,
%ENCRYPTION
,
%PATTERN
);
our
@EXPORT_OK
= (
qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize decode decrypt_cookie deprecated dumper)
,
qw(encode encrypt_cookie extract_usage generate_secret getopt gunzip gzip header_params hmac_sha1_sum)
,
qw(html_attr_unescape html_unescape humanize_bytes md5_bytes md5_sum monkey_patch network_contains punycode_decode)
,
qw(punycode_encode quote scope_guard secure_compare sha1_bytes sha1_sum slugify split_cookie_header split_header)
,
qw(steady_time tablify term_escape trim unindent unquote url_escape url_unescape xml_escape xor_encode)
);
# Aliases
monkey_patch(__PACKAGE__,
'b64_decode'
, \
&decode_base64
);
monkey_patch(__PACKAGE__,
'b64_encode'
, \
&encode_base64
);
monkey_patch(__PACKAGE__,
'hmac_sha1_sum'
, \
&hmac_sha1_hex
);
monkey_patch(__PACKAGE__,
'md5_bytes'
, \
&md5
);
monkey_patch(__PACKAGE__,
'md5_sum'
, \
&md5_hex
);
monkey_patch(__PACKAGE__,
'sha1_bytes'
, \
&sha1
);
monkey_patch(__PACKAGE__,
'sha1_sum'
, \
&sha1_hex
);
# Use a monotonic clock if possible
monkey_patch(__PACKAGE__,
'steady_time'
,
MONOTONIC ?
sub
() { Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC()) } : \
&Time::HiRes::time
);
sub
camelize {
my
$str
=
shift
;
return
$str
if
$str
=~ /^[A-Z]/;
# CamelCase words
return
join
'::'
,
map
{
join
(
''
,
map
{
ucfirst
lc
}
split
/_/)
}
split
/-/,
$str
;
}
sub
class_to_file {
my
$class
=
shift
;
$class
=~ s/::|'//g;
$class
=~ s/([A-Z])([A-Z]*)/$1 .
lc
$2/ge;
return
decamelize(
$class
);
}
sub
decamelize {
my
$str
=
shift
;
return
$str
if
$str
!~ /^[A-Z]/;
# snake_case words
return
join
'-'
,
map
{
join
(
'_'
,
map
{
lc
}
grep
{
length
}
split
/([A-Z]{1}[^A-Z]*)/)
}
split
/::/,
$str
;
}
sub
decrypt_cookie {
my
(
$value
,
$key
,
$salt
) =
@_
;
croak
'CryptX 0.080+ required for encrypted cookie support'
unless
CRYPTX;
return
undef
unless
$value
=~ /^([^-]+)-([^-]+)-([^-]+)$/;
my
(
$ct
,
$iv
,
$tag
) = ($1, $2, $3);
(
$ct
,
$iv
,
$tag
) = (Crypt::Misc::decode_b64(
$ct
), Crypt::Misc::decode_b64(
$iv
), Crypt::Misc::decode_b64(
$tag
));
my
$dk
=
$ENCRYPTION
{
$key
}{
$salt
} ||= Crypt::KeyDerivation::pbkdf2(
$key
,
$salt
);
return
Crypt::AuthEnc::ChaCha20Poly1305::chacha20poly1305_decrypt_verify(
$dk
,
$iv
,
''
,
$ct
,
$tag
);
}
sub
decode {
my
(
$encoding
,
$bytes
) =
@_
;
return
undef
unless
eval
{
$bytes
= _encoding(
$encoding
)->decode(
"$bytes"
, 1); 1 };
return
$bytes
;
}
sub
deprecated {
local
$Carp::CarpLevel
= 1;
$ENV
{MOJO_FATAL_DEPRECATIONS} ? croak
@_
: carp
@_
;
}
sub
dumper { Data::Dumper->new([
@_
])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Dump }
sub
encode { _encoding(
$_
[0])->encode(
"$_[1]"
, 0) }
sub
encrypt_cookie {
my
(
$value
,
$key
,
$salt
) =
@_
;
croak
'CryptX 0.080+ required for encrypted cookie support'
unless
CRYPTX;
my
$dk
=
$ENCRYPTION
{
$key
}{
$salt
} ||= Crypt::KeyDerivation::pbkdf2(
$key
,
$salt
);
my
$iv
= Crypt::PRNG::random_bytes(12);
my
(
$ct
,
$tag
) = Crypt::AuthEnc::ChaCha20Poly1305::chacha20poly1305_encrypt_authenticate(
$dk
,
$iv
,
''
,
$value
);
return
join
'-'
, Crypt::Misc::encode_b64(
$ct
), Crypt::Misc::encode_b64(
$iv
), Crypt::Misc::encode_b64(
$tag
);
}
sub
extract_usage {
my
$file
=
@_
?
"$_[0]"
: (
caller
)[1];
open
my
$handle
,
'>'
, \
my
$output
;
pod2usage
-exitval
=>
'noexit'
,
-input
=>
$file
,
-output
=>
$handle
;
$output
=~ s/^.*\n|\n$//;
$output
=~ s/\n$//;
return
unindent(
$output
);
}
sub
generate_secret {
return
Crypt::Misc::encode_b64u(Crypt::PRNG::random_bytes(128))
if
CRYPTX;
srand
;
return
sha1_sum($$ . steady_time() .
rand
);
}
sub
getopt {
my
(
$array
,
$opts
) =
map
{
ref
$_
[0] eq
'ARRAY'
?
shift
:
$_
} \
@ARGV
, [];
my
$save
= Getopt::Long::Configure(
qw(default no_auto_abbrev no_ignore_case)
,
@$opts
);
my
$result
= GetOptionsFromArray
$array
,
@_
;
Getopt::Long::Configure(
$save
);
return
$result
;
}
sub
gunzip {
my
$compressed
=
shift
;
IO::Uncompress::Gunzip::gunzip \
$compressed
, \
my
$uncompressed
or croak
"Couldn't gunzip: $IO::Uncompress::Gunzip::GzipError"
;
return
$uncompressed
;
}
sub
gzip {
my
$uncompressed
=
shift
;
IO::Compress::Gzip::gzip \
$uncompressed
, \
my
$compressed
or croak
"Couldn't gzip: $IO::Compress::Gzip::GzipError"
;
return
$compressed
;
}
sub
header_params {
my
$value
=
shift
;
my
$params
= {};
while
(
$value
=~ /\G[;\s]*([^=;, ]+)\s*/gc) {
my
$name
= $1;
# Quoted value
if
(
$value
=~ /
$QUOTED_VALUE_RE
/gco) {
$params
->{
$name
} //= unquote($1) }
# Unquoted value
elsif
(
$value
=~ /
$UNQUOTED_VALUE_RE
/gco) {
$params
->{
$name
} //= $1 }
}
return
(
$params
,
substr
(
$value
,
pos
(
$value
) // 0));
}
sub
html_attr_unescape { _html(
shift
, 1) }
sub
html_unescape { _html(
shift
, 0) }
sub
humanize_bytes {
my
$size
=
shift
;
my
$prefix
=
$size
< 0 ?
'-'
:
''
;
return
"$prefix${size}B"
if
(
$size
=
abs
$size
) < 1024;
return
$prefix
. _round(
$size
) .
'KiB'
if
(
$size
/= 1024) < 1024;
return
$prefix
. _round(
$size
) .
'MiB'
if
(
$size
/= 1024) < 1024;
return
$prefix
. _round(
$size
) .
'GiB'
if
(
$size
/= 1024) < 1024;
return
$prefix
. _round(
$size
/= 1024) .
'TiB'
;
}
sub
network_contains {
my
(
$cidr
,
$addr
) =
@_
;
return
undef
unless
length
$cidr
&&
length
$addr
;
# Parse inputs
my
(
$net
,
$mask
) =
split
m!/!,
$cidr
, 2;
my
$v6
=
$net
=~ /:/;
return
undef
if
$v6
xor
$addr
=~ /:/;
# Convert addresses to binary
return
undef
unless
$net
= inet_pton(
$v6
? AF_INET6 : AF_INET,
$net
);
return
undef
unless
$addr
= inet_pton(
$v6
? AF_INET6 : AF_INET,
$addr
);
my
$length
=
$v6
? 128 : 32;
# Apply mask if given
$addr
&=
pack
"B$length"
,
'1'
x
$mask
if
defined
$mask
;
# Compare
return
0 ==
unpack
"B$length"
, (
$net
^
$addr
);
}
# Direct translation of RFC 3492
sub
punycode_decode {
my
$input
=
shift
;
my
(
$n
,
$i
,
$bias
,
@output
) = (PC_INITIAL_N, 0, PC_INITIAL_BIAS);
# Consume all code points before the last delimiter
push
@output
,
split
(//, $1)
if
$input
=~ s/(.*)\x2d//s;
while
(
length
$input
) {
my
(
$oldi
,
$w
) = (
$i
, 1);
# Base to infinity in steps of base
for
(
my
$k
= PC_BASE; 1;
$k
+= PC_BASE) {
my
$digit
=
ord
substr
$input
, 0, 1,
''
;
$digit
=
$digit
< 0x40 ?
$digit
+ (26 - 0x30) : (
$digit
& 0x1f) - 1;
$i
+=
$digit
*
$w
;
my
$t
=
$k
-
$bias
;
$t
=
$t
< PC_TMIN ? PC_TMIN :
$t
> PC_TMAX ? PC_TMAX :
$t
;
last
if
$digit
<
$t
;
$w
*= PC_BASE -
$t
;
}
$bias
= _adapt(
$i
-
$oldi
,
@output
+ 1,
$oldi
== 0);
$n
+=
$i
/ (
@output
+ 1);
$i
=
$i
% (
@output
+ 1);
splice
@output
,
$i
++, 0,
chr
$n
;
}
return
join
''
,
@output
;
}
# Direct translation of RFC 3492
sub
punycode_encode {
my
$output
=
shift
;
my
(
$n
,
$delta
,
$bias
) = (PC_INITIAL_N, 0, PC_INITIAL_BIAS);
# Extract basic code points
my
@input
=
map
{
ord
}
split
//,
$output
;
$output
=~ s/[^\x00-\x7f]+//gs;
my
$h
=
my
$basic
=
length
$output
;
$output
.=
"\x2d"
if
$basic
> 0;
for
my
$m
(
sort
grep
{
$_
>= PC_INITIAL_N }
@input
) {
next
if
$m
<
$n
;
$delta
+= (
$m
-
$n
) * (
$h
+ 1);
$n
=
$m
;
for
my
$c
(
@input
) {
if
(
$c
<
$n
) {
$delta
++ }
elsif
(
$c
==
$n
) {
my
$q
=
$delta
;
# Base to infinity in steps of base
for
(
my
$k
= PC_BASE; 1;
$k
+= PC_BASE) {
my
$t
=
$k
-
$bias
;
$t
=
$t
< PC_TMIN ? PC_TMIN :
$t
> PC_TMAX ? PC_TMAX :
$t
;
last
if
$q
<
$t
;
my
$o
=
$t
+ ((
$q
-
$t
) % (PC_BASE -
$t
));
$output
.=
chr
$o
+ (
$o
< 26 ? 0x61 : 0x30 - 26);
$q
= (
$q
-
$t
) / (PC_BASE -
$t
);
}
$output
.=
chr
$q
+ (
$q
< 26 ? 0x61 : 0x30 - 26);
$bias
= _adapt(
$delta
,
$h
+ 1,
$h
==
$basic
);
$delta
= 0;
$h
++;
}
}
$delta
++;
$n
++;
}
return
$output
;
}
sub
quote {
my
$str
=
shift
;
$str
=~ s/(["\\])/\\$1/g;
return
qq{"$str"}
;
}
sub
scope_guard { Mojo::Util::_Guard->new(
cb
=>
shift
) }
sub
secure_compare {
my
(
$one
,
$two
) =
@_
;
my
$r
=
length
$one
!=
length
$two
;
$two
=
$one
if
$r
;
$r
|=
ord
(
substr
$one
,
$_
) ^
ord
(
substr
$two
,
$_
)
for
0 ..
length
(
$one
) - 1;
return
$r
== 0;
}
sub
slugify {
my
(
$value
,
$allow_unicode
) =
@_
;
if
(
$allow_unicode
) {
# Force unicode semantics by upgrading string
utf8::upgrade(
$value
= Unicode::Normalize::NFKC(
$value
));
$value
=~ s/[^\w\s-]+//g;
}
else
{
$value
= Unicode::Normalize::NFKD(
$value
);
$value
=~ s/[^a-zA-Z0-9_\p{PosixSpace}-]+//g;
}
(
my
$new
=
lc
trim(
$value
)) =~ s/[-\s]+/-/g;
return
$new
;
}
sub
split_cookie_header { _header(
shift
, 1) }
sub
split_header { _header(
shift
, 0) }
sub
tablify {
my
$rows
=
shift
;
my
@spec
;
for
my
$row
(
@$rows
) {
for
my
$i
(0 ..
$#$row
) {
(
$row
->[
$i
] //=
''
) =~ y/\r\n//d;
my
$len
=
length
$row
->[
$i
];
$spec
[
$i
] =
$len
if
$len
>= (
$spec
[
$i
] // 0);
}
}
my
@fm
= (
map
({
"\%-${_}s"
}
@spec
[0 ..
$#spec
- 1]),
'%s'
);
return
join
''
,
map
{
sprintf
join
(
' '
,
@fm
[0 ..
$#$_
]) .
"\n"
,
@$_
}
@$rows
;
}
sub
term_escape {
my
$str
=
shift
;
$str
=~ s/([\x00-\x09\x0b-\x1f\x7f\x80-\x9f])/
sprintf
'\\x%02x'
,
ord
$1/ge;
return
$str
;
}
sub
trim {
my
$str
=
shift
;
$str
=~ s/^\s+//;
$str
=~ s/\s+$//;
return
$str
;
}
sub
unindent {
my
$str
=
shift
;
my
$min
= min
map
{ m/^([ \t]*)/;
length
$1 || () }
split
/\n/,
$str
;
$str
=~ s/^[ \t]{0,
$min
}//gm
if
$min
;
return
$str
;
}
sub
unquote {
my
$str
=
shift
;
return
$str
unless
$str
=~ s/^
"(.*)"
$/$1/g;
$str
=~ s/\\\\/\\/g;
$str
=~ s/\\
"/"
/g;
return
$str
;
}
sub
url_escape {
my
(
$str
,
$pattern
) =
@_
;
if
(
$pattern
) {
unless
(
exists
$PATTERN
{
$pattern
}) {
(
my
$quoted
=
$pattern
) =~ s!([/\$\[])!\\$1!g;
$PATTERN
{
$pattern
} =
eval
"sub { \$_[0] =~ s/([$quoted])/sprintf '%%%02X', ord \$1/ge }"
or croak $@;
}
$PATTERN
{
$pattern
}->(
$str
);
}
else
{
$str
=~ s/([^A-Za-z0-9\-._~])/
sprintf
'%%%02X'
,
ord
$1/ge }
return
$str
;
}
sub
url_unescape {
my
$str
=
shift
;
$str
=~ s/%([0-9a-fA-F]{2})/
chr
hex
$1/ge;
return
$str
;
}
sub
xml_escape {
return
$_
[0]
if
ref
$_
[0] &&
ref
$_
[0] eq
'Mojo::ByteStream'
;
my
$str
=
shift
//
''
;
$str
=~ s/([&<>"'])/
$XML
{$1}/ge;
return
$str
;
}
sub
xor_encode {
my
(
$input
,
$key
) =
@_
;
# Encode with variable key length
my
$len
=
length
$key
;
my
$buffer
=
my
$output
=
''
;
$output
.=
$buffer
^
$key
while
length
(
$buffer
=
substr
(
$input
, 0,
$len
,
''
)) ==
$len
;
return
$output
.=
$buffer
^
substr
(
$key
, 0,
length
$buffer
,
''
);
}
sub
_adapt {
my
(
$delta
,
$numpoints
,
$firsttime
) =
@_
;
$delta
=
$firsttime
?
$delta
/ PC_DAMP :
$delta
/ 2;
$delta
+=
$delta
/
$numpoints
;
my
$k
= 0;
while
(
$delta
> ((PC_BASE - PC_TMIN) * PC_TMAX) / 2) {
$delta
/= PC_BASE - PC_TMIN;
$k
+= PC_BASE;
}
return
$k
+ (((PC_BASE - PC_TMIN + 1) *
$delta
) / (
$delta
+ PC_SKEW));
}
sub
_encoding {
$ENCODING
{
$_
[0]} //= find_encoding(
$_
[0]) // croak
"Unknown encoding '$_[0]'"
}
sub
_entity {
my
(
$point
,
$name
,
$attr
) =
@_
;
# Code point
return
chr
(
$point
!~ /^x/ ?
$point
:
hex
$point
)
unless
defined
$name
;
# Named character reference
my
$rest
=
my
$last
=
''
;
while
(
length
$name
) {
return
$ENTITIES
{
$name
} .
reverse
$rest
if
exists
$ENTITIES
{
$name
} && (!
$attr
||
$name
=~ /;$/ ||
$last
!~ /[A-Za-z0-9=]/);
$rest
.=
$last
=
chop
$name
;
}
return
'&'
.
reverse
$rest
;
}
sub
_header {
my
(
$str
,
$cookie
) =
@_
;
my
(
@tree
,
@part
);
while
(
$str
=~ /\G[,;\s]*([^=;, ]+)\s*/gc) {
push
@part
, $1,
undef
;
my
$expires
=
$cookie
&&
@part
> 2 &&
lc
$1 eq
'expires'
;
# Special "expires" value
if
(
$expires
&&
$str
=~ /\G=\s
*$EXPIRES_RE
/gco) {
$part
[-1] = $1 }
# Quoted value
elsif
(
$str
=~ /
$QUOTED_VALUE_RE
/gco) {
$part
[-1] = unquote $1 }
# Unquoted value
elsif
(
$str
=~ /
$UNQUOTED_VALUE_RE
/gco) {
$part
[-1] = $1 }
# Separator
next
unless
$str
=~ /\G[;\s]*,\s*/gc;
push
@tree
, [
@part
];
@part
= ();
}
# Take care of final part
return
[
@part
? (
@tree
, \
@part
) :
@tree
];
}
sub
_html {
my
(
$str
,
$attr
) =
@_
;
$str
=~ s/
$ENTITY_RE
/_entity($1, $2,
$attr
)/geo;
return
$str
;
}
sub
_options {
# Hash or name (one)
return
ref
$_
[0] eq
'HASH'
? (
undef
, %{
shift
()}) :
@_
if
@_
== 1;
# Name and values (odd)
return
shift
,
@_
if
@_
% 2;
# Name and hash or just values (even)
return
ref
$_
[1] eq
'HASH'
? (
shift
, %{
shift
()}) : (
undef
,
@_
);
}
# This may break in the future, but is worth it for performance
sub
_readable { !!(IO::Poll::_poll(
@_
[0, 1],
my
$m
= POLLIN | POLLPRI) > 0) }
sub
_round {
$_
[0] < 10 ?
int
(
$_
[0] * 10 + 0.5) / 10 :
int
(
$_
[0] + 0.5) }
sub
_stash {
my
(
$name
,
$object
) = (
shift
,
shift
);
# Hash
return
$object
->{
$name
} //= {}
unless
@_
;
# Get
return
$object
->{
$name
}{
$_
[0]}
unless
@_
> 1 ||
ref
$_
[0];
# Set
my
$values
=
ref
$_
[0] ?
$_
[0] : {
@_
};
@{
$object
->{
$name
}}{
keys
%$values
} =
values
%$values
;
return
$object
;
}
sub
_teardown {
return
unless
my
$class
=
shift
;
# @ISA has to be cleared first because of circular references
no
strict
'refs'
;
@{
"${class}::ISA"
} = ();
delete_package
$class
;
}
package
Mojo::Util::_Guard;
use
Mojo::Base -base;
sub
DESTROY {
shift
->{cb}() }
1;
=encoding utf8
=head1 NAME
Mojo::Util - Portable utility functions
=head1 SYNOPSIS
use Mojo::Util qw(b64_encode url_escape url_unescape);
my $str = 'test=23';
my $escaped = url_escape $str;
say url_unescape $escaped;
say b64_encode $escaped, '';
=head1 DESCRIPTION
L<Mojo::Util> provides portable utility functions for L<Mojo>.
=head1 FUNCTIONS
L<Mojo::Util> implements the following functions, which can be imported individually.
=head2 b64_decode
my $bytes = b64_decode $b64;
Base64 decode bytes with L<MIME::Base64>.
=head2 b64_encode
my $b64 = b64_encode $bytes;
my $b64 = b64_encode $bytes, "\n";
Base64 encode bytes with L<MIME::Base64>, the line ending defaults to a newline.
=head2 camelize
my $camelcase = camelize $snakecase;
Convert C<snake_case> string to C<CamelCase> and replace C<-> with C<::>.
# "FooBar"
camelize 'foo_bar';
# "FooBar::Baz"
camelize 'foo_bar-baz';
# "FooBar::Baz"
camelize 'FooBar::Baz';
=head2 class_to_file
my $file = class_to_file 'Foo::Bar';
Convert a class name to a file.
# "foo_bar"
class_to_file 'Foo::Bar';
# "foobar"
class_to_file 'FOO::Bar';
# "foo_bar"
class_to_file 'FooBar';
# "foobar"
class_to_file 'FOOBar';
=head2 class_to_path
my $path = class_to_path 'Foo::Bar';
Convert class name to path, as used by C<%INC>.
# "Foo/Bar.pm"
class_to_path 'Foo::Bar';
# "FooBar.pm"
class_to_path 'FooBar';
=head2 decamelize
my $snakecase = decamelize $camelcase;
Convert C<CamelCase> string to C<snake_case> and replace C<::> with C<->.
# "foo_bar"
decamelize 'FooBar';
# "foo_bar-baz"
decamelize 'FooBar::Baz';
# "foo_bar-baz"
decamelize 'foo_bar-baz';
=head2 decode
my $chars = decode 'UTF-8', $bytes;
Decode bytes to characters with L<Encode>, or return C<undef> if decoding failed.
=head2 decrypt_cookie
my $value = decrypt_cookie $encrypted, 'passw0rd', 'salt';
Decrypt cookie value encrypted with L</encrypt_cookie>, returns the decrypted value or C<undef>. Note that this
function is B<EXPERIMENTAL> and might change without warning!
=head2 deprecated
deprecated 'foo is DEPRECATED in favor of bar';
Warn about deprecated feature from perspective of caller. You can also set the C<MOJO_FATAL_DEPRECATIONS> environment
variable to make them die instead with L<Carp>.
=head2 dumper
my $perl = dumper {some => 'data'};
Dump a Perl data structure with L<Data::Dumper>.
=head2 encode
my $bytes = encode 'UTF-8', $chars;
Encode characters to bytes with L<Encode>.
=head2 encrypt_cookie
my $encrypted = encrypt_cookie $value, 'passw0rd', 'salt';
Encrypt cookie value. Note that this function is B<EXPERIMENTAL> and might change without warning!
=head2 extract_usage
my $usage = extract_usage;
my $usage = extract_usage '/home/sri/foo.pod';
Extract usage message from the SYNOPSIS section of a file containing POD documentation, defaults to using the file this
function was called from.
# "Usage: APPLICATION test [OPTIONS]\n"
extract_usage;
=head1 SYNOPSIS
Usage: APPLICATION test [OPTIONS]
=cut
=head2 generate_secret
my $secret = generate_secret;
Generate a random secret with a cryptographically secure random number generator if available, and a less secure
fallback if not. Note that this function is B<EXPERIMENTAL> and might change without warning!
=head2 getopt
getopt
'H|headers=s' => \my @headers,
't|timeout=i' => \my $timeout,
'v|verbose' => \my $verbose;
getopt $array,
'H|headers=s' => \my @headers,
't|timeout=i' => \my $timeout,
'v|verbose' => \my $verbose;
getopt $array, ['pass_through'],
'H|headers=s' => \my @headers,
't|timeout=i' => \my $timeout,
'v|verbose' => \my $verbose;
Extract options from an array reference with L<Getopt::Long>, but without changing its global configuration, defaults
to using C<@ARGV>. The configuration options C<no_auto_abbrev> and C<no_ignore_case> are enabled by default.
# Extract "charset" option
getopt ['--charset', 'UTF-8'], 'charset=s' => \my $charset;
say $charset;
=head2 gunzip
my $uncompressed = gunzip $compressed;
Uncompress bytes with L<IO::Compress::Gunzip>.
=head2 gzip
my $compressed = gzip $uncompressed;
Compress bytes with L<IO::Compress::Gzip>.
=head2 header_params
my ($params, $remainder) = header_params 'one=foo; two="bar", three=baz';
Extract HTTP header field parameters until the first comma according to L<RFC 5987|http://tools.ietf.org/html/rfc5987>.
Note that this function is B<EXPERIMENTAL> and might change without warning!
=head2 hmac_sha1_sum
my $checksum = hmac_sha1_sum $bytes, 'passw0rd';
Generate HMAC-SHA1 checksum for bytes with L<Digest::SHA>.
# "11cedfd5ec11adc0ec234466d8a0f2a83736aa68"
hmac_sha1_sum 'foo', 'passw0rd';
=head2 html_attr_unescape
my $str = html_attr_unescape $escaped;
Same as L</"html_unescape">, but handles special rules from the L<HTML Living Standard|https://html.spec.whatwg.org>
for HTML attributes.
# "foo=bar<est=baz"
html_attr_unescape 'foo=bar<est=baz';
# "foo=bar<est=baz"
html_attr_unescape 'foo=bar<est=baz';
=head2 html_unescape
my $str = html_unescape $escaped;
Unescape all HTML entities in string.
# "<div>"
html_unescape '<div>';
=head2 humanize_bytes
my $str = humanize_bytes 1234;
Turn number of bytes into a simplified human readable format.
# "1B"
humanize_bytes 1;
# "7.5GiB"
humanize_bytes 8007188480;
# "13GiB"
humanize_bytes 13443399680;
# "-685MiB"
humanize_bytes -717946880;
=head2 md5_bytes
my $checksum = md5_bytes $bytes;
Generate binary MD5 checksum for bytes with L<Digest::MD5>.
=head2 md5_sum
my $checksum = md5_sum $bytes;
Generate MD5 checksum for bytes with L<Digest::MD5>.
# "acbd18db4cc2f85cedef654fccc4a4d8"
md5_sum 'foo';
=head2 monkey_patch
monkey_patch $package, foo => sub {...};
monkey_patch $package, foo => sub {...}, bar => sub {...};
Monkey patch functions into package.
monkey_patch 'MyApp',
one => sub { say 'One!' },
two => sub { say 'Two!' },
three => sub { say 'Three!' };
=head2 punycode_decode
my $str = punycode_decode $punycode;
Punycode decode string as described in L<RFC 3492|https://tools.ietf.org/html/rfc3492>.
# "bücher"
punycode_decode 'bcher-kva';
=head2 network_contains
my $bool = network_contains $network, $address;
Check that a given address is contained within a network in CIDR form. If the network is a single address, the
addresses must be equivalent.
# True
network_contains('10.0.0.0/8', '10.10.10.10');
network_contains('10.10.10.10', '10.10.10.10');
network_contains('fc00::/7', 'fc::c0:ff:ee');
# False
network_contains('10.0.0.0/29', '10.10.10.10');
network_contains('10.10.10.12', '10.10.10.10');
network_contains('fc00::/7', '::1');
=head2 punycode_encode
my $punycode = punycode_encode $str;
Punycode encode string as described in L<RFC 3492|https://tools.ietf.org/html/rfc3492>.
# "bcher-kva"
punycode_encode 'bücher';
=head2 quote
my $quoted = quote $str;
Quote string.
=head2 scope_guard
my $guard = scope_guard sub {...};
Create anonymous scope guard object that will execute the passed callback when the object is destroyed.
# Execute closure at end of scope
{
my $guard = scope_guard sub { say "Mojo!" };
say "Hello";
}
=head2 secure_compare
my $bool = secure_compare $str1, $str2;
Constant time comparison algorithm to prevent timing attacks. The secret string should be the second argument, to avoid
leaking information about the length of the string.
=head2 sha1_bytes
my $checksum = sha1_bytes $bytes;
Generate binary SHA1 checksum for bytes with L<Digest::SHA>.
=head2 sha1_sum
my $checksum = sha1_sum $bytes;
Generate SHA1 checksum for bytes with L<Digest::SHA>.
# "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33"
sha1_sum 'foo';
=head2 slugify
my $slug = slugify $string;
my $slug = slugify $string, $bool;
Returns a URL slug generated from the input string. Non-word characters are removed, the string is trimmed and
lowercased, and whitespace characters are replaced by a dash. By default, non-ASCII characters are normalized to ASCII
word characters or removed, but if a true value is passed as the second parameter, all word characters will be allowed
in the result according to unicode semantics.
# "joel-is-a-slug"
slugify 'Joel is a slug';
# "this-is-my-resume"
slugify 'This is: my - résumé! ☃ ';
# "this-is-my-résumé"
slugify 'This is: my - résumé! ☃ ', 1;
=head2 split_cookie_header
my $tree = split_cookie_header 'a=b; expires=Thu, 07 Aug 2008 07:07:59 GMT';
Same as L</"split_header">, but handles C<expires> values from L<RFC 6265|https://tools.ietf.org/html/rfc6265>.
=head2 split_header
my $tree = split_header 'foo="bar baz"; test=123, yada';
Split HTTP header value into key/value pairs, each comma separated part gets its own array reference, and keys without
a value get C<undef> assigned.
# "one"
split_header('one; two="three four", five=six')->[0][0];
# "two"
split_header('one; two="three four", five=six')->[0][2];
# "three four"
split_header('one; two="three four", five=six')->[0][3];
# "five"
split_header('one; two="three four", five=six')->[1][0];
# "six"
split_header('one; two="three four", five=six')->[1][1];
=head2 steady_time
my $time = steady_time;
High resolution time elapsed from an arbitrary fixed point in the past, resilient to time jumps if a monotonic clock is
available through L<Time::HiRes>.
=head2 tablify
my $table = tablify [['foo', 'bar'], ['baz', 'yada']];
Row-oriented generator for text tables.
# "foo bar\nyada yada\nbaz yada\n"
tablify [['foo', 'bar'], ['yada', 'yada'], ['baz', 'yada']];
=head2 term_escape
my $escaped = term_escape $str;
Escape all POSIX control characters except for C<\n>.
# "foo\\x09bar\\x0d\n"
term_escape "foo\tbar\r\n";
=head2 trim
my $trimmed = trim $str;
Trim whitespace characters from both ends of string.
# "foo bar"
trim ' foo bar ';
=head2 unindent
my $unindented = unindent $str;
Unindent multi-line string.
# "foo\nbar\nbaz\n"
unindent " foo\n bar\n baz\n";
=head2 unquote
my $str = unquote $quoted;
Unquote string.
=head2 url_escape
my $escaped = url_escape $str;
my $escaped = url_escape $str, '^A-Za-z0-9\-._~';
Percent encode unsafe characters in string as described in L<RFC 3986|https://tools.ietf.org/html/rfc3986>, the pattern
used defaults to C<^A-Za-z0-9\-._~>.
# "foo%3Bbar"
url_escape 'foo;bar';
=head2 url_unescape
my $str = url_unescape $escaped;
Decode percent encoded characters in string as described in L<RFC 3986|https://tools.ietf.org/html/rfc3986>.
# "foo;bar"
url_unescape 'foo%3Bbar';
=head2 xml_escape
my $escaped = xml_escape $str;
Escape unsafe characters C<&>, C<E<lt>>, C<E<gt>>, C<"> and C<'> in string, but do not escape L<Mojo::ByteStream>
objects.
# "<div>"
xml_escape '<div>';
# "<div>"
use Mojo::ByteStream qw(b);
xml_escape b('<div>');
=head2 xor_encode
my $encoded = xor_encode $str, $key;
XOR encode string with variable length key.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
=cut