1package Mojo::Util; 2use Mojo::Base -strict; 3 4use Carp qw(carp croak); 5use Data::Dumper (); 6use Digest::MD5 qw(md5 md5_hex); 7use Digest::SHA qw(hmac_sha1_hex sha1 sha1_hex); 8use Encode qw(find_encoding); 9use Exporter qw(import); 10use File::Basename qw(dirname); 11use Getopt::Long qw(GetOptionsFromArray); 12use IO::Compress::Gzip; 13use IO::Poll qw(POLLIN POLLPRI); 14use IO::Uncompress::Gunzip; 15use List::Util qw(min); 16use MIME::Base64 qw(decode_base64 encode_base64); 17use Pod::Usage qw(pod2usage); 18use Socket qw(inet_pton AF_INET6 AF_INET); 19use Sub::Util qw(set_subname); 20use Symbol qw(delete_package); 21use Time::HiRes (); 22use Unicode::Normalize (); 23 24# Check for monotonic clock support 25use constant MONOTONIC => eval { !!Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC()) }; 26 27# Punycode bootstring parameters 28use constant { 29 PC_BASE => 36, 30 PC_TMIN => 1, 31 PC_TMAX => 26, 32 PC_SKEW => 38, 33 PC_DAMP => 700, 34 PC_INITIAL_BIAS => 72, 35 PC_INITIAL_N => 128 36}; 37 38# To generate a new HTML entity table run this command 39# perl examples/entities.pl > lib/Mojo/resources/html_entities.txt 40my %ENTITIES; 41{ 42 # Don't use Mojo::File here due to circular dependencies 43 my $path = File::Spec->catfile(dirname(__FILE__), 'resources', 'html_entities.txt'); 44 45 open my $file, '<', $path or croak "Unable to open html entities file ($path): $!"; 46 my $lines = do { local $/; <$file> }; 47 48 for my $line (split /\n/, $lines) { 49 next unless $line =~ /^(\S+)\s+U\+(\S+)(?:\s+U\+(\S+))?/; 50 $ENTITIES{$1} = defined $3 ? (chr(hex $2) . chr(hex $3)) : chr(hex $2); 51 } 52} 53 54# Characters that should be escaped in XML 55my %XML = ('&' => '&', '<' => '<', '>' => '>', '"' => '"', '\'' => '''); 56 57# "Sun, 06 Nov 1994 08:49:37 GMT" and "Sunday, 06-Nov-94 08:49:37 GMT" 58my $EXPIRES_RE = qr/(\w+\W+\d+\W+\w+\W+\d+\W+\d+:\d+:\d+\W*\w+)/; 59 60# HTML entities 61my $ENTITY_RE = qr/&(?:\#((?:[0-9]{1,7}|x[0-9a-fA-F]{1,6}));|(\w+[;=]?))/; 62 63# Encoding and pattern cache 64my (%ENCODING, %PATTERN); 65 66our @EXPORT_OK = ( 67 qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize decode deprecated dumper encode), 68 qw(extract_usage getopt gunzip gzip hmac_sha1_sum html_attr_unescape html_unescape humanize_bytes md5_bytes md5_sum), 69 qw(monkey_patch network_contains punycode_decode punycode_encode quote scope_guard secure_compare sha1_bytes), 70 qw(sha1_sum slugify split_cookie_header split_header steady_time tablify term_escape trim unindent unquote), 71 qw(url_escape url_unescape xml_escape xor_encode) 72); 73 74# Aliases 75monkey_patch(__PACKAGE__, 'b64_decode', \&decode_base64); 76monkey_patch(__PACKAGE__, 'b64_encode', \&encode_base64); 77monkey_patch(__PACKAGE__, 'hmac_sha1_sum', \&hmac_sha1_hex); 78monkey_patch(__PACKAGE__, 'md5_bytes', \&md5); 79monkey_patch(__PACKAGE__, 'md5_sum', \&md5_hex); 80monkey_patch(__PACKAGE__, 'sha1_bytes', \&sha1); 81monkey_patch(__PACKAGE__, 'sha1_sum', \&sha1_hex); 82 83# Use a monotonic clock if possible 84monkey_patch(__PACKAGE__, 'steady_time', 85 MONOTONIC ? sub () { Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC()) } : \&Time::HiRes::time); 86 87sub camelize { 88 my $str = shift; 89 return $str if $str =~ /^[A-Z]/; 90 91 # CamelCase words 92 return join '::', map { 93 join('', map { ucfirst lc } split /_/) 94 } split /-/, $str; 95} 96 97sub class_to_file { 98 my $class = shift; 99 $class =~ s/::|'//g; 100 $class =~ s/([A-Z])([A-Z]*)/$1 . lc $2/ge; 101 return decamelize($class); 102} 103 104sub class_to_path { join '.', join('/', split(/::|'/, shift)), 'pm' } 105 106sub decamelize { 107 my $str = shift; 108 return $str if $str !~ /^[A-Z]/; 109 110 # snake_case words 111 return join '-', map { 112 join('_', map {lc} grep {length} split /([A-Z]{1}[^A-Z]*)/) 113 } split /::/, $str; 114} 115 116sub decode { 117 my ($encoding, $bytes) = @_; 118 return undef unless eval { $bytes = _encoding($encoding)->decode("$bytes", 1); 1 }; 119 return $bytes; 120} 121 122sub deprecated { 123 local $Carp::CarpLevel = 1; 124 $ENV{MOJO_FATAL_DEPRECATIONS} ? croak @_ : carp @_; 125} 126 127sub dumper { Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Dump } 128 129sub encode { _encoding($_[0])->encode("$_[1]", 0) } 130 131sub extract_usage { 132 my $file = @_ ? "$_[0]" : (caller)[1]; 133 134 open my $handle, '>', \my $output; 135 pod2usage -exitval => 'noexit', -input => $file, -output => $handle; 136 $output =~ s/^.*\n|\n$//; 137 $output =~ s/\n$//; 138 139 return unindent($output); 140} 141 142sub getopt { 143 my ($array, $opts) = map { ref $_[0] eq 'ARRAY' ? shift : $_ } \@ARGV, []; 144 145 my $save = Getopt::Long::Configure(qw(default no_auto_abbrev no_ignore_case), @$opts); 146 my $result = GetOptionsFromArray $array, @_; 147 Getopt::Long::Configure($save); 148 149 return $result; 150} 151 152sub gunzip { 153 my $compressed = shift; 154 IO::Uncompress::Gunzip::gunzip \$compressed, \my $uncompressed 155 or croak "Couldn't gunzip: $IO::Uncompress::Gunzip::GzipError"; 156 return $uncompressed; 157} 158 159sub gzip { 160 my $uncompressed = shift; 161 IO::Compress::Gzip::gzip \$uncompressed, \my $compressed or croak "Couldn't gzip: $IO::Compress::Gzip::GzipError"; 162 return $compressed; 163} 164 165sub html_attr_unescape { _html(shift, 1) } 166sub html_unescape { _html(shift, 0) } 167 168sub humanize_bytes { 169 my $size = shift; 170 171 my $prefix = $size < 0 ? '-' : ''; 172 173 return "$prefix${size}B" if ($size = abs $size) < 1024; 174 return $prefix . _round($size) . 'KiB' if ($size /= 1024) < 1024; 175 return $prefix . _round($size) . 'MiB' if ($size /= 1024) < 1024; 176 return $prefix . _round($size) . 'GiB' if ($size /= 1024) < 1024; 177 return $prefix . _round($size /= 1024) . 'TiB'; 178} 179 180sub monkey_patch { 181 my ($class, %patch) = @_; 182 no strict 'refs'; 183 no warnings 'redefine'; 184 *{"${class}::$_"} = set_subname("${class}::$_", $patch{$_}) for keys %patch; 185} 186 187sub network_contains { 188 my ($cidr, $addr) = @_; 189 return undef unless length $cidr && length $addr; 190 191 # Parse inputs 192 my ($net, $mask) = split m!/!, $cidr, 2; 193 my $v6 = $net =~ /:/; 194 return undef if $v6 xor $addr =~ /:/; 195 196 # Convert addresses to binary 197 return undef unless $net = inet_pton($v6 ? AF_INET6 : AF_INET, $net); 198 return undef unless $addr = inet_pton($v6 ? AF_INET6 : AF_INET, $addr); 199 my $length = $v6 ? 128 : 32; 200 201 # Apply mask if given 202 $addr &= pack "B$length", '1' x $mask if defined $mask; 203 204 # Compare 205 return 0 == unpack "B$length", ($net ^ $addr); 206} 207 208# Direct translation of RFC 3492 209sub punycode_decode { 210 my $input = shift; 211 use integer; 212 213 my ($n, $i, $bias, @output) = (PC_INITIAL_N, 0, PC_INITIAL_BIAS); 214 215 # Consume all code points before the last delimiter 216 push @output, split(//, $1) if $input =~ s/(.*)\x2d//s; 217 218 while (length $input) { 219 my ($oldi, $w) = ($i, 1); 220 221 # Base to infinity in steps of base 222 for (my $k = PC_BASE; 1; $k += PC_BASE) { 223 my $digit = ord substr $input, 0, 1, ''; 224 $digit = $digit < 0x40 ? $digit + (26 - 0x30) : ($digit & 0x1f) - 1; 225 $i += $digit * $w; 226 my $t = $k - $bias; 227 $t = $t < PC_TMIN ? PC_TMIN : $t > PC_TMAX ? PC_TMAX : $t; 228 last if $digit < $t; 229 $w *= PC_BASE - $t; 230 } 231 232 $bias = _adapt($i - $oldi, @output + 1, $oldi == 0); 233 $n += $i / (@output + 1); 234 $i = $i % (@output + 1); 235 splice @output, $i++, 0, chr $n; 236 } 237 238 return join '', @output; 239} 240 241# Direct translation of RFC 3492 242sub punycode_encode { 243 my $output = shift; 244 use integer; 245 246 my ($n, $delta, $bias) = (PC_INITIAL_N, 0, PC_INITIAL_BIAS); 247 248 # Extract basic code points 249 my @input = map {ord} split //, $output; 250 $output =~ s/[^\x00-\x7f]+//gs; 251 my $h = my $basic = length $output; 252 $output .= "\x2d" if $basic > 0; 253 254 for my $m (sort grep { $_ >= PC_INITIAL_N } @input) { 255 next if $m < $n; 256 $delta += ($m - $n) * ($h + 1); 257 $n = $m; 258 259 for my $c (@input) { 260 261 if ($c < $n) { $delta++ } 262 elsif ($c == $n) { 263 my $q = $delta; 264 265 # Base to infinity in steps of base 266 for (my $k = PC_BASE; 1; $k += PC_BASE) { 267 my $t = $k - $bias; 268 $t = $t < PC_TMIN ? PC_TMIN : $t > PC_TMAX ? PC_TMAX : $t; 269 last if $q < $t; 270 my $o = $t + (($q - $t) % (PC_BASE - $t)); 271 $output .= chr $o + ($o < 26 ? 0x61 : 0x30 - 26); 272 $q = ($q - $t) / (PC_BASE - $t); 273 } 274 275 $output .= chr $q + ($q < 26 ? 0x61 : 0x30 - 26); 276 $bias = _adapt($delta, $h + 1, $h == $basic); 277 $delta = 0; 278 $h++; 279 } 280 } 281 282 $delta++; 283 $n++; 284 } 285 286 return $output; 287} 288 289sub quote { 290 my $str = shift; 291 $str =~ s/(["\\])/\\$1/g; 292 return qq{"$str"}; 293} 294 295sub scope_guard { Mojo::Util::_Guard->new(cb => shift) } 296 297sub secure_compare { 298 my ($one, $two) = @_; 299 my $r = length $one != length $two; 300 $two = $one if $r; 301 $r |= ord(substr $one, $_) ^ ord(substr $two, $_) for 0 .. length($one) - 1; 302 return $r == 0; 303} 304 305sub slugify { 306 my ($value, $allow_unicode) = @_; 307 308 if ($allow_unicode) { 309 310 # Force unicode semantics by upgrading string 311 utf8::upgrade($value = Unicode::Normalize::NFKC($value)); 312 $value =~ s/[^\w\s-]+//g; 313 } 314 else { 315 $value = Unicode::Normalize::NFKD($value); 316 $value =~ s/[^a-zA-Z0-9_\p{PosixSpace}-]+//g; 317 } 318 (my $new = lc trim($value)) =~ s/[-\s]+/-/g; 319 320 return $new; 321} 322 323sub split_cookie_header { _header(shift, 1) } 324sub split_header { _header(shift, 0) } 325 326sub tablify { 327 my $rows = shift; 328 329 my @spec; 330 for my $row (@$rows) { 331 for my $i (0 .. $#$row) { 332 ($row->[$i] //= '') =~ y/\r\n//d; 333 my $len = length $row->[$i]; 334 $spec[$i] = $len if $len >= ($spec[$i] // 0); 335 } 336 } 337 338 my @fm = (map({"\%-${_}s"} @spec[0 .. $#spec - 1]), '%s'); 339 return join '', map { sprintf join(' ', @fm[0 .. $#$_]) . "\n", @$_ } @$rows; 340} 341 342sub term_escape { 343 my $str = shift; 344 $str =~ s/([\x00-\x09\x0b-\x1f\x7f\x80-\x9f])/sprintf '\\x%02x', ord $1/ge; 345 return $str; 346} 347 348sub trim { 349 my $str = shift; 350 $str =~ s/^\s+//; 351 $str =~ s/\s+$//; 352 return $str; 353} 354 355sub unindent { 356 my $str = shift; 357 my $min = min map { m/^([ \t]*)/; length $1 || () } split /\n/, $str; 358 $str =~ s/^[ \t]{0,$min}//gm if $min; 359 return $str; 360} 361 362sub unquote { 363 my $str = shift; 364 return $str unless $str =~ s/^"(.*)"$/$1/g; 365 $str =~ s/\\\\/\\/g; 366 $str =~ s/\\"/"/g; 367 return $str; 368} 369 370sub url_escape { 371 my ($str, $pattern) = @_; 372 373 if ($pattern) { 374 unless (exists $PATTERN{$pattern}) { 375 (my $quoted = $pattern) =~ s!([/\$\[])!\\$1!g; 376 $PATTERN{$pattern} = eval "sub { \$_[0] =~ s/([$quoted])/sprintf '%%%02X', ord \$1/ge }" or croak $@; 377 } 378 $PATTERN{$pattern}->($str); 379 } 380 else { $str =~ s/([^A-Za-z0-9\-._~])/sprintf '%%%02X', ord $1/ge } 381 382 return $str; 383} 384 385sub url_unescape { 386 my $str = shift; 387 $str =~ s/%([0-9a-fA-F]{2})/chr hex $1/ge; 388 return $str; 389} 390 391sub xml_escape { 392 return $_[0] if ref $_[0] && ref $_[0] eq 'Mojo::ByteStream'; 393 my $str = shift // ''; 394 $str =~ s/([&<>"'])/$XML{$1}/ge; 395 return $str; 396} 397 398sub xor_encode { 399 my ($input, $key) = @_; 400 401 # Encode with variable key length 402 my $len = length $key; 403 my $buffer = my $output = ''; 404 $output .= $buffer ^ $key while length($buffer = substr($input, 0, $len, '')) == $len; 405 return $output .= $buffer ^ substr($key, 0, length $buffer, ''); 406} 407 408sub _adapt { 409 my ($delta, $numpoints, $firsttime) = @_; 410 use integer; 411 412 $delta = $firsttime ? $delta / PC_DAMP : $delta / 2; 413 $delta += $delta / $numpoints; 414 my $k = 0; 415 while ($delta > ((PC_BASE - PC_TMIN) * PC_TMAX) / 2) { 416 $delta /= PC_BASE - PC_TMIN; 417 $k += PC_BASE; 418 } 419 420 return $k + (((PC_BASE - PC_TMIN + 1) * $delta) / ($delta + PC_SKEW)); 421} 422 423sub _encoding { $ENCODING{$_[0]} //= find_encoding($_[0]) // croak "Unknown encoding '$_[0]'" } 424 425sub _entity { 426 my ($point, $name, $attr) = @_; 427 428 # Code point 429 return chr($point !~ /^x/ ? $point : hex $point) unless defined $name; 430 431 # Named character reference 432 my $rest = my $last = ''; 433 while (length $name) { 434 return $ENTITIES{$name} . reverse $rest 435 if exists $ENTITIES{$name} && (!$attr || $name =~ /;$/ || $last !~ /[A-Za-z0-9=]/); 436 $rest .= $last = chop $name; 437 } 438 return '&' . reverse $rest; 439} 440 441sub _header { 442 my ($str, $cookie) = @_; 443 444 my (@tree, @part); 445 while ($str =~ /\G[,;\s]*([^=;, ]+)\s*/gc) { 446 push @part, $1, undef; 447 my $expires = $cookie && @part > 2 && lc $1 eq 'expires'; 448 449 # Special "expires" value 450 if ($expires && $str =~ /\G=\s*$EXPIRES_RE/gco) { $part[-1] = $1 } 451 452 # Quoted value 453 elsif ($str =~ /\G=\s*("(?:\\\\|\\"|[^"])*")/gc) { $part[-1] = unquote $1 } 454 455 # Unquoted value 456 elsif ($str =~ /\G=\s*([^;, ]*)/gc) { $part[-1] = $1 } 457 458 # Separator 459 next unless $str =~ /\G[;\s]*,\s*/gc; 460 push @tree, [@part]; 461 @part = (); 462 } 463 464 # Take care of final part 465 return [@part ? (@tree, \@part) : @tree]; 466} 467 468sub _html { 469 my ($str, $attr) = @_; 470 $str =~ s/$ENTITY_RE/_entity($1, $2, $attr)/geo; 471 return $str; 472} 473 474sub _options { 475 476 # Hash or name (one) 477 return ref $_[0] eq 'HASH' ? (undef, %{shift()}) : @_ if @_ == 1; 478 479 # Name and values (odd) 480 return shift, @_ if @_ % 2; 481 482 # Name and hash or just values (even) 483 return ref $_[1] eq 'HASH' ? (shift, %{shift()}) : (undef, @_); 484} 485 486# This may break in the future, but is worth it for performance 487sub _readable { !!(IO::Poll::_poll(@_[0, 1], my $m = POLLIN | POLLPRI) > 0) } 488 489sub _round { $_[0] < 10 ? int($_[0] * 10 + 0.5) / 10 : int($_[0] + 0.5) } 490 491sub _stash { 492 my ($name, $object) = (shift, shift); 493 494 # Hash 495 return $object->{$name} //= {} unless @_; 496 497 # Get 498 return $object->{$name}{$_[0]} unless @_ > 1 || ref $_[0]; 499 500 # Set 501 my $values = ref $_[0] ? $_[0] : {@_}; 502 @{$object->{$name}}{keys %$values} = values %$values; 503 504 return $object; 505} 506 507sub _teardown { 508 return unless my $class = shift; 509 510 # @ISA has to be cleared first because of circular references 511 no strict 'refs'; 512 @{"${class}::ISA"} = (); 513 delete_package $class; 514} 515 516package Mojo::Util::_Guard; 517use Mojo::Base -base; 518 519sub DESTROY { shift->{cb}() } 520 5211; 522 523=encoding utf8 524 525=head1 NAME 526 527Mojo::Util - Portable utility functions 528 529=head1 SYNOPSIS 530 531 use Mojo::Util qw(b64_encode url_escape url_unescape); 532 533 my $str = 'test=23'; 534 my $escaped = url_escape $str; 535 say url_unescape $escaped; 536 say b64_encode $escaped, ''; 537 538=head1 DESCRIPTION 539 540L<Mojo::Util> provides portable utility functions for L<Mojo>. 541 542=head1 FUNCTIONS 543 544L<Mojo::Util> implements the following functions, which can be imported individually. 545 546=head2 b64_decode 547 548 my $bytes = b64_decode $b64; 549 550Base64 decode bytes with L<MIME::Base64>. 551 552=head2 b64_encode 553 554 my $b64 = b64_encode $bytes; 555 my $b64 = b64_encode $bytes, "\n"; 556 557Base64 encode bytes with L<MIME::Base64>, the line ending defaults to a newline. 558 559=head2 camelize 560 561 my $camelcase = camelize $snakecase; 562 563Convert C<snake_case> string to C<CamelCase> and replace C<-> with C<::>. 564 565 # "FooBar" 566 camelize 'foo_bar'; 567 568 # "FooBar::Baz" 569 camelize 'foo_bar-baz'; 570 571 # "FooBar::Baz" 572 camelize 'FooBar::Baz'; 573 574=head2 class_to_file 575 576 my $file = class_to_file 'Foo::Bar'; 577 578Convert a class name to a file. 579 580 # "foo_bar" 581 class_to_file 'Foo::Bar'; 582 583 # "foobar" 584 class_to_file 'FOO::Bar'; 585 586 # "foo_bar" 587 class_to_file 'FooBar'; 588 589 # "foobar" 590 class_to_file 'FOOBar'; 591 592=head2 class_to_path 593 594 my $path = class_to_path 'Foo::Bar'; 595 596Convert class name to path, as used by C<%INC>. 597 598 # "Foo/Bar.pm" 599 class_to_path 'Foo::Bar'; 600 601 # "FooBar.pm" 602 class_to_path 'FooBar'; 603 604=head2 decamelize 605 606 my $snakecase = decamelize $camelcase; 607 608Convert C<CamelCase> string to C<snake_case> and replace C<::> with C<->. 609 610 # "foo_bar" 611 decamelize 'FooBar'; 612 613 # "foo_bar-baz" 614 decamelize 'FooBar::Baz'; 615 616 # "foo_bar-baz" 617 decamelize 'foo_bar-baz'; 618 619=head2 decode 620 621 my $chars = decode 'UTF-8', $bytes; 622 623Decode bytes to characters with L<Encode>, or return C<undef> if decoding failed. 624 625=head2 deprecated 626 627 deprecated 'foo is DEPRECATED in favor of bar'; 628 629Warn about deprecated feature from perspective of caller. You can also set the C<MOJO_FATAL_DEPRECATIONS> environment 630variable to make them die instead with L<Carp>. 631 632=head2 dumper 633 634 my $perl = dumper {some => 'data'}; 635 636Dump a Perl data structure with L<Data::Dumper>. 637 638=head2 encode 639 640 my $bytes = encode 'UTF-8', $chars; 641 642Encode characters to bytes with L<Encode>. 643 644=head2 extract_usage 645 646 my $usage = extract_usage; 647 my $usage = extract_usage '/home/sri/foo.pod'; 648 649Extract usage message from the SYNOPSIS section of a file containing POD documentation, defaults to using the file this 650function was called from. 651 652 # "Usage: APPLICATION test [OPTIONS]\n" 653 extract_usage; 654 655 =head1 SYNOPSIS 656 657 Usage: APPLICATION test [OPTIONS] 658 659 =cut 660 661=head2 getopt 662 663 getopt 664 'H|headers=s' => \my @headers, 665 't|timeout=i' => \my $timeout, 666 'v|verbose' => \my $verbose; 667 getopt $array, 668 'H|headers=s' => \my @headers, 669 't|timeout=i' => \my $timeout, 670 'v|verbose' => \my $verbose; 671 getopt $array, ['pass_through'], 672 'H|headers=s' => \my @headers, 673 't|timeout=i' => \my $timeout, 674 'v|verbose' => \my $verbose; 675 676Extract options from an array reference with L<Getopt::Long>, but without changing its global configuration, defaults 677to using C<@ARGV>. The configuration options C<no_auto_abbrev> and C<no_ignore_case> are enabled by default. 678 679 # Extract "charset" option 680 getopt ['--charset', 'UTF-8'], 'charset=s' => \my $charset; 681 say $charset; 682 683=head2 gunzip 684 685 my $uncompressed = gunzip $compressed; 686 687Uncompress bytes with L<IO::Compress::Gunzip>. 688 689=head2 gzip 690 691 my $compressed = gzip $uncompressed; 692 693Compress bytes with L<IO::Compress::Gzip>. 694 695=head2 hmac_sha1_sum 696 697 my $checksum = hmac_sha1_sum $bytes, 'passw0rd'; 698 699Generate HMAC-SHA1 checksum for bytes with L<Digest::SHA>. 700 701 # "11cedfd5ec11adc0ec234466d8a0f2a83736aa68" 702 hmac_sha1_sum 'foo', 'passw0rd'; 703 704=head2 html_attr_unescape 705 706 my $str = html_attr_unescape $escaped; 707 708Same as L</"html_unescape">, but handles special rules from the L<HTML Living Standard|https://html.spec.whatwg.org> 709for HTML attributes. 710 711 # "foo=bar<est=baz" 712 html_attr_unescape 'foo=bar<est=baz'; 713 714 # "foo=bar<est=baz" 715 html_attr_unescape 'foo=bar<est=baz'; 716 717=head2 html_unescape 718 719 my $str = html_unescape $escaped; 720 721Unescape all HTML entities in string. 722 723 # "<div>" 724 html_unescape '<div>'; 725 726=head2 humanize_bytes 727 728 my $str = humanize_bytes 1234; 729 730Turn number of bytes into a simplified human readable format. 731 732 # "1B" 733 humanize_bytes 1; 734 735 # "7.5GiB" 736 humanize_bytes 8007188480; 737 738 # "13GiB" 739 humanize_bytes 13443399680; 740 741 # "-685MiB" 742 humanize_bytes -717946880; 743 744=head2 md5_bytes 745 746 my $checksum = md5_bytes $bytes; 747 748Generate binary MD5 checksum for bytes with L<Digest::MD5>. 749 750=head2 md5_sum 751 752 my $checksum = md5_sum $bytes; 753 754Generate MD5 checksum for bytes with L<Digest::MD5>. 755 756 # "acbd18db4cc2f85cedef654fccc4a4d8" 757 md5_sum 'foo'; 758 759=head2 monkey_patch 760 761 monkey_patch $package, foo => sub {...}; 762 monkey_patch $package, foo => sub {...}, bar => sub {...}; 763 764Monkey patch functions into package. 765 766 monkey_patch 'MyApp', 767 one => sub { say 'One!' }, 768 two => sub { say 'Two!' }, 769 three => sub { say 'Three!' }; 770 771=head2 punycode_decode 772 773 my $str = punycode_decode $punycode; 774 775Punycode decode string as described in L<RFC 3492|https://tools.ietf.org/html/rfc3492>. 776 777 # "bücher" 778 punycode_decode 'bcher-kva'; 779 780=head2 network_contains 781 782 my $bool = network_contains $network, $address; 783 784Check that a given address is contained within a network in CIDR form. If the network is a single address, the 785addresses must be equivalent. 786 787 # True 788 network_contains('10.0.0.0/8', '10.10.10.10'); 789 network_contains('10.10.10.10', '10.10.10.10'); 790 network_contains('fc00::/7', 'fc::c0:ff:ee'); 791 792 # False 793 network_contains('10.0.0.0/29', '10.10.10.10'); 794 network_contains('10.10.10.12', '10.10.10.10'); 795 network_contains('fc00::/7', '::1'); 796 797=head2 punycode_encode 798 799 my $punycode = punycode_encode $str; 800 801Punycode encode string as described in L<RFC 3492|https://tools.ietf.org/html/rfc3492>. 802 803 # "bcher-kva" 804 punycode_encode 'bücher'; 805 806=head2 quote 807 808 my $quoted = quote $str; 809 810Quote string. 811 812=head2 scope_guard 813 814 my $guard = scope_guard sub {...}; 815 816Create anonymous scope guard object that will execute the passed callback when the object is destroyed. 817 818 # Execute closure at end of scope 819 { 820 my $guard = scope_guard sub { say "Mojo!" }; 821 say "Hello"; 822 } 823 824=head2 secure_compare 825 826 my $bool = secure_compare $str1, $str2; 827 828Constant time comparison algorithm to prevent timing attacks. The secret string should be the second argument, to avoid 829leaking information about the length of the string. 830 831=head2 sha1_bytes 832 833 my $checksum = sha1_bytes $bytes; 834 835Generate binary SHA1 checksum for bytes with L<Digest::SHA>. 836 837=head2 sha1_sum 838 839 my $checksum = sha1_sum $bytes; 840 841Generate SHA1 checksum for bytes with L<Digest::SHA>. 842 843 # "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33" 844 sha1_sum 'foo'; 845 846=head2 slugify 847 848 my $slug = slugify $string; 849 my $slug = slugify $string, $bool; 850 851Returns a URL slug generated from the input string. Non-word characters are removed, the string is trimmed and 852lowercased, and whitespace characters are replaced by a dash. By default, non-ASCII characters are normalized to ASCII 853word characters or removed, but if a true value is passed as the second parameter, all word characters will be allowed 854in the result according to unicode semantics. 855 856 # "joel-is-a-slug" 857 slugify 'Joel is a slug'; 858 859 # "this-is-my-resume" 860 slugify 'This is: my - résumé! ☃ '; 861 862 # "this-is-my-résumé" 863 slugify 'This is: my - résumé! ☃ ', 1; 864 865=head2 split_cookie_header 866 867 my $tree = split_cookie_header 'a=b; expires=Thu, 07 Aug 2008 07:07:59 GMT'; 868 869Same as L</"split_header">, but handles C<expires> values from L<RFC 6265|https://tools.ietf.org/html/rfc6265>. 870 871=head2 split_header 872 873 my $tree = split_header 'foo="bar baz"; test=123, yada'; 874 875Split HTTP header value into key/value pairs, each comma separated part gets its own array reference, and keys without 876a value get C<undef> assigned. 877 878 # "one" 879 split_header('one; two="three four", five=six')->[0][0]; 880 881 # "two" 882 split_header('one; two="three four", five=six')->[0][2]; 883 884 # "three four" 885 split_header('one; two="three four", five=six')->[0][3]; 886 887 # "five" 888 split_header('one; two="three four", five=six')->[1][0]; 889 890 # "six" 891 split_header('one; two="three four", five=six')->[1][1]; 892 893=head2 steady_time 894 895 my $time = steady_time; 896 897High resolution time elapsed from an arbitrary fixed point in the past, resilient to time jumps if a monotonic clock is 898available through L<Time::HiRes>. 899 900=head2 tablify 901 902 my $table = tablify [['foo', 'bar'], ['baz', 'yada']]; 903 904Row-oriented generator for text tables. 905 906 # "foo bar\nyada yada\nbaz yada\n" 907 tablify [['foo', 'bar'], ['yada', 'yada'], ['baz', 'yada']]; 908 909=head2 term_escape 910 911 my $escaped = term_escape $str; 912 913Escape all POSIX control characters except for C<\n>. 914 915 # "foo\\x09bar\\x0d\n" 916 term_escape "foo\tbar\r\n"; 917 918=head2 trim 919 920 my $trimmed = trim $str; 921 922Trim whitespace characters from both ends of string. 923 924 # "foo bar" 925 trim ' foo bar '; 926 927=head2 unindent 928 929 my $unindented = unindent $str; 930 931Unindent multi-line string. 932 933 # "foo\nbar\nbaz\n" 934 unindent " foo\n bar\n baz\n"; 935 936=head2 unquote 937 938 my $str = unquote $quoted; 939 940Unquote string. 941 942=head2 url_escape 943 944 my $escaped = url_escape $str; 945 my $escaped = url_escape $str, '^A-Za-z0-9\-._~'; 946 947Percent encode unsafe characters in string as described in L<RFC 3986|https://tools.ietf.org/html/rfc3986>, the pattern 948used defaults to C<^A-Za-z0-9\-._~>. 949 950 # "foo%3Bbar" 951 url_escape 'foo;bar'; 952 953=head2 url_unescape 954 955 my $str = url_unescape $escaped; 956 957Decode percent encoded characters in string as described in L<RFC 3986|https://tools.ietf.org/html/rfc3986>. 958 959 # "foo;bar" 960 url_unescape 'foo%3Bbar'; 961 962=head2 xml_escape 963 964 my $escaped = xml_escape $str; 965 966Escape unsafe characters C<&>, C<E<lt>>, C<E<gt>>, C<"> and C<'> in string, but do not escape L<Mojo::ByteStream> 967objects. 968 969 # "<div>" 970 xml_escape '<div>'; 971 972 # "<div>" 973 use Mojo::ByteStream qw(b); 974 xml_escape b('<div>'); 975 976=head2 xor_encode 977 978 my $encoded = xor_encode $str, $key; 979 980XOR encode string with variable length key. 981 982=head1 SEE ALSO 983 984L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>. 985 986=cut 987