File Coverage

blib/lib/Mojo/Util.pm

Criterion	Covered	Total	%
statement	354	380	93.1
branch	132	154	85.7
condition	49	67	73.1
subroutine	78	80	97.5
pod	37	37	100.0
total	650	718	90.5

package Mojo::Util;
use Mojo::Base -strict;

use Carp           qw(carp croak);
use Data::Dumper   ();
use Digest::MD5    qw(md5 md5_hex);
use Digest::SHA    qw(hmac_sha1_hex sha1 sha1_hex);
use Encode         qw(find_encoding);
use Errno          ();
use Exporter       qw(import);
use File::Basename qw(dirname);
use Getopt::Long   qw(GetOptionsFromArray);
use IO::Compress::Gzip;
use IO::Poll qw(POLLIN POLLPRI);
use IO::Uncompress::Gunzip;
use List::Util         qw(min);
use MIME::Base64       qw(decode_base64 encode_base64 encode_base64url);
use Mojo::BaseUtil     qw(class_to_path monkey_patch);
use Pod::Usage         qw(pod2usage);
use Socket             qw(inet_pton AF_INET6 AF_INET);
use Symbol             qw(delete_package);
use Time::HiRes        ();
use Unicode::Normalize ();

# Encryption support requires CryptX 0.080+
use constant CRYPTX => $ENV{MOJO_NO_CRYPTX} ? 0 : !!(eval {
  require CryptX;
  require Crypt::AuthEnc::ChaCha20Poly1305;
  require Crypt::KeyDerivation;
  require Crypt::Misc;
  require Crypt::PRNG;
  CryptX->VERSION('0.080');
  1;
});
use constant WIN32_API => eval { require Win32::API };

# Check for monotonic clock support
use constant MONOTONIC => !!eval { Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC()) };

# 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 random_bytes scope_guard secure_compare sha1_bytes sha1_sum slugify split_cookie_header),
  qw(split_header 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 encode_base64url(random_bytes(128));
}

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;
  use integer;

  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;
  use integer;

  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 { $a <=> $b } 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 random_bytes {
  my ($count) = @_;
  croak 'Byte count must be a defined, non-negative integer' unless defined $count && $count =~ /\A\d+\z/a;
  if (CRYPTX) {
    return Crypt::PRNG::random_bytes($count);
  }
  elsif (WIN32_API) {
    state $genrand = Win32::API->new('advapi32', 'INT SystemFunction036(PVOID RandomBuffer, ULONG RandomBufferLength)')
      or die "Could not import SystemFunction036: $^E";
    return '' if $count == 0;
    my $buffer = chr(0) x $count;
    $genrand->Call($buffer, $count) or croak("Could not read random bytes");
    return $buffer;
  }
  elsif (-e '/dev/urandom') {
    open my $fh, '<:raw', '/dev/urandom' or die "Couldn't open /dev/urandom: $!";
    my ($result, $offset) = ('', 0);
    while ($offset < $count) {
      my $read = sysread $fh, $result, $count - $offset, $offset;
      next                                 if not defined $read and $!{EINTR};
      croak("Could not read random bytes") if not defined $read or $read == 0;
      $offset += $read;
    }
    return $result;
  }
  else {
    die "Can't find source of randomness on your system, consider installing CryptX";
  }
}

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) = @_;
  use integer;

  $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 provides portable utility functions for L.

=head1 FUNCTIONS

L implements the following functions, which can be imported individually.

=head2 b64_decode

  my $bytes = b64_decode $b64;

Base64 decode bytes with L.

=head2 b64_encode

  my $b64 = b64_encode $bytes;
  my $b64 = b64_encode $bytes, "\n";

Base64 encode bytes with L, the line ending defaults to a newline.

=head2 camelize

  my $camelcase = camelize $snakecase;

Convert C string to C 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 string to C 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, or return C if decoding failed.

=head2 decrypt_cookie

  my $value = decrypt_cookie $encrypted, 'passw0rd', 'salt';

Decrypt cookie value encrypted with L, returns the decrypted value or C.

=head2 deprecated

  deprecated 'foo is DEPRECATED in favor of bar';

Warn about deprecated feature from perspective of caller. You can also set the C environment
variable to make them die instead with L.

=head2 dumper

  my $perl = dumper {some => 'data'};

Dump a Perl data structure with L.

=head2 encode

  my $bytes = encode 'UTF-8', $chars;

Encode characters to bytes with L.

=head2 encrypt_cookie

  my $encrypted = encrypt_cookie $value, 'passw0rd', 'salt';

Encrypt cookie value.

=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.

=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, but without changing its global configuration, defaults
to using C<@ARGV>. The configuration options C and C 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.

=head2 gzip

  my $compressed = gzip $uncompressed;

Compress bytes with L.

=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.

=head2 hmac_sha1_sum

  my $checksum = hmac_sha1_sum $bytes, 'passw0rd';

Generate HMAC-SHA1 checksum for bytes with L.

  # "11cedfd5ec11adc0ec234466d8a0f2a83736aa68"
  hmac_sha1_sum 'foo', 'passw0rd';

=head2 html_attr_unescape

  my $str = html_attr_unescape $escaped;

Same as L, but handles special rules from the L
for HTML attributes.

  # "foo=bar<est=baz"
  html_attr_unescape 'foo=bar<est=baz';

  # "foo=bar
  html_attr_unescape 'foo=bar<est=baz';

=head2 html_unescape

  my $str = html_unescape $escaped;

Unescape all HTML entities in string.

  # ""
  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.

=head2 md5_sum

  my $checksum = md5_sum $bytes;

Generate MD5 checksum for bytes with L.

  # "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 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_decode

  my $str = punycode_decode $punycode;

Punycode decode string as described in L.

  # "bücher"
  punycode_decode 'bcher-kva';

=head2 punycode_encode

  my $punycode = punycode_encode $str;

Punycode encode string as described in L.

  # "bcher-kva"
  punycode_encode 'bücher';

=head2 quote

  my $quoted = quote $str;

Quote string.

=head2 random_bytes

 my $random = random_bytes($bytes);

Generate C<$bytes> worth of high entropy randomness.

=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.

=head2 sha1_sum

  my $checksum = sha1_sum $bytes;

Generate SHA1 checksum for bytes with L.

  # "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, but handles C values from L.

=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 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.

=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, 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.

  # "foo;bar"
  url_unescape 'foo%3Bbar';

=head2 xml_escape

  my $escaped = xml_escape $str;

Escape unsafe characters C<&>, C>, C>, C<"> and C<'> in string, but do not escape L
objects.

  # "<div>"
  xml_escape '';

  # ""
  use Mojo::ByteStream qw(b);
  xml_escape b('');

=head2 xor_encode

  my $encoded = xor_encode $str, $key;

XOR encode string with variable length key.

=head1 SEE ALSO

L, L, L.

=cut