view release on metacpan or  search on metacpan

lib/Mojo/Util.pm  view on Meta::CPAN

    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 ? '-' : '';