Crypt::Util - A lightweight Crypt/Digest convenience API

	use Crypt::Util; # also has a Sub::Exporter to return functions wrapping a default instance

	my $util = Crypt::Util->new;

	$util->default_key("my secret");

	# MAC or cipher+digest based tamper resistent encapsulation
	# (uses Storable on $data if necessary)
	my $tamper_resistent_string = $util->tamper_proof( $data );

	my $verified = $util->thaw_tamper_proof( $untrusted_string, key => "another secret" );

	# If the encoding is unspecified, base32 is used
	# (hex if base32 is unavailable)
	my $encoded = $util->encode_string( $bytes );

	my $hash = $util->digest( $bytes, digest => "md5" );

	die "baaaad" unless $util->verify_hash(
		hash   => $hash,
		data   => $bytes,
		digest => "md5",
	);

    package A;
    use Crypt::Util qw/:all/;

    default_key("moose");
    my $ciphertext = encrypt_string($plain);




    package B;
    use Crypt::Util qw/:all/;

    default_key("elk");
    my $ciphertext = encrypt_string($plain);

#!/usr/bin/perl

package Crypt::Util;
use Moose;

our $VERSION = "0.11";

use Digest;
use Digest::MoreFallbacks;

use Carp qw/croak/;

use Sub::Exporter;
use Data::OptList;

use namespace::clean -except => [qw(meta)];

our %DEFAULT_ACCESSORS = (
	mode                     => { isa => "Str" },
	authenticated_mode       => { isa => "Str" },
	encode                   => { isa => "Bool" },
	encoding                 => { isa => "Str" },
	printable_encoding       => { isa => "Str" },
	alphanumerical_encoding  => { isa => "Str" },
	uri_encoding             => { isa => "Str" },
	digest                   => { isa => "Str" },
	cipher                   => { isa => "Str" },
	mac                      => { isa => "Str" },
	key                      => { isa => "Str" },
	uri_encoding             => { isa => "Str" },
	printable_encoding       => { isa => "Str" },
	use_literal_key          => { isa => "Bool" },
	tamper_proof_unencrypted => { isa => "Bool" },
	nonce                    => { isa => "Str", default => "" },
);

our @DEFAULT_ACCESSORS = keys %DEFAULT_ACCESSORS;

my %export_groups = (
	'crypt' => [qw/
		encrypt_string decrypt_string
		authenticated_encrypt_string
		tamper_proof thaw_tamper_proof
		cipher_object
	/],
	digest => [qw/
		digest_string verify_hash verify_digest
		digest_object
		mac_digest_string
		verify_mac
	/],
	encoding => [qw/
		encode_string decode_string
		encode_string_hex decode_string_hex
		encode_string_base64 decode_string_base64 encode_string_base64_wrapped
		encode_string_base32 decode_string_base32
		encode_string_uri_base64 decode_string_uri_base64
		encode_string_uri decode_string_uri
		encode_string_alphanumerical decode_string_alphanumerical
		encode_string_printable decode_string_printable
		encode_string_uri_escape decode_string_uri_escape
	/],
	params => [ "exported_instance", "disable_fallback", map { "default_$_" } @DEFAULT_ACCESSORS ],
);

my %exports = map { $_ => \&__curry_instance } map { @$_ } values %export_groups;

Sub::Exporter->import( -setup => {
	exports    => \%exports,
	groups     => \%export_groups,
	collectors => {
		defaults => sub { 1 },
	},
});

our @KNOWN_AUTHENTICATING_MODES = qw(EAX OCB GCM CWC CCM); # IACBC & IAPM will probably never be implemented

our %KNOWN_AUTHENTICATING_MODES = map { $_ => 1 } @KNOWN_AUTHENTICATING_MODES;

our %FALLBACK_LISTS = (
	mode                    => [qw/CFB CBC Ctr OFB/],
	stream_mode             => [qw/CFB Ctr OFB/],
	block_mode              => [qw/CBC/],
	authenticated_mode      => [qw/EAX GCM CCM/], # OCB/], OCB is patented
	cipher                  => [qw/Rijndael Serpent Twofish RC6 Blowfish RC5/],
	#authenticated_cipher    => [qw/Phelix SOBER-128 Helix/], # not yet ready
	digest                  => [qw/SHA-1 SHA-256 RIPEMD160 Whirlpool MD5 Haval256/],
	mac                     => [qw/HMAC CMAC/],
	encoding                => [qw/hex/],
	printable_encoding      => [qw/base64 hex/],
	alphanumerical_encoding => [qw/base32 hex/],
	uri_encoding            => [qw/uri_base64 base32 hex/],
);

foreach my $fallback ( keys %FALLBACK_LISTS ) {
	my @list = @{ $FALLBACK_LISTS{$fallback} };

	my $list_method = "fallback_${fallback}_list";

	my $list_method_sub = sub { # derefed list accessors
		my ( $self, @args ) = @_;
		if ( @args ) {
			@args = @{ $args[0] } if @args == 1 and (ref($args[0])||'') eq "ARRAY";
			$self->{$list_method} = \@args;
		}
		@{ $self->{$list_method} || \@list };
	};

	my $type = ( $fallback =~ /(encoding|mode)/ )[0] || $fallback;
	my $try = "_try_${type}_fallback";

	my $fallback_sub = sub {
		my $self = shift;

		$self->_find_fallback(
			$fallback,
			$try,
			$self->$list_method,
		) || croak "Couldn't load any $fallback";
	};

	no strict 'refs';
	*{ "fallback_$fallback" } = $fallback_sub;
	*{ $list_method } = $list_method_sub;
}

foreach my $attr ( @DEFAULT_ACCESSORS ) {
	has "default_$attr" => (
		is => "rw",
		predicate => "has_default_$attr",
		clearer   => "clear_default_$attr",
		( __PACKAGE__->can("fallback_$attr") ? (
			lazy_build => 1,
			builder => "fallback_$attr",
		) : () ),
		%{ $DEFAULT_ACCESSORS{$attr} },
	);
}

has disable_fallback => (
	isa => "Bool",
	is  => "rw",
);

__PACKAGE__->meta->make_immutable if __PACKAGE__->meta->can("make_immutable");

{
	my %fallback_caches;

	sub _find_fallback {
		my ( $self, $key, $test, @list ) = @_;

		my $cache = $fallback_caches{$key} ||= {};

		@list = $list[0] if @list and $self->disable_fallback;

		foreach my $elem ( @list ) {
			$cache->{$elem} = $self->$test( $elem ) unless exists $cache->{$elem};
			return $elem if $cache->{$elem};
		}


		return;
	}
}

sub _try_cipher_fallback {
	my ( $self, $name ) = @_;
	$self->_try_loading_module("Crypt::$name");
}

sub _try_digest_fallback {
	my ( $self, $name ) = @_;

	my $e;

	{
		local $@;
		eval { $self->digest_object( digest => $name ) };
		$e = $@;
	};

	return 1 if !$e;
	( my $file = $name ) =~ s{::}{/}g;
	die $e if $e !~ m{^Can't locate Digest/\Q${file}.pm\E in \@INC};
	return;
}

sub _try_mode_fallback {
	my ( $self, $mode ) = @_;
	$self->_try_loading_module("Crypt::$mode");
}

sub _try_mac_fallback {
	my ( $self, $mac ) = @_;
	$self->_try_loading_module("Digest::$mac");
}

sub _try_loading_module {
	my ( $self, $name ) = @_;

	(my $file = "${name}.pm") =~ s{::}{/}g;

	my ( $r, $e );
	{
		local $@;
		$r = eval { require $file }; # yes it's portable
		$e = $@;
	};

	return $r if $r;
	die $e if $e !~ /^Can't locate \Q$file\E in \@INC/;
	return $r;
}

{
	my %encoding_module = (
		base64     => "MIME::Base64",
		uri_base64 => "MIME::Base64::URLSafe",
		base32     => "MIME::Base32",
		uri_escape => "URI::Escape",
	);

	sub _try_encoding_fallback {
		my ( $self, $encoding ) = @_;

		return 1 if $encoding eq "hex";

		my $module = $encoding_module{$encoding};
		$module =~ s{::}{/}g;
		$module .= ".pm";

		my $e = do {
			local $@;
			eval { require $module }; # yes it's portable
			$@;
		};

		return 1 if !$e;
		die $e if $e !~ /^Can't locate \Q$module\E in \@INC/;
		return;
	}
}

sub _args (\@;$) {
	my ( $args, $odd ) = @_;

	my ( $self, @args ) = @$args;

	my %params;
	if ( @args % 2 == 1 ) {
		croak "The parameters must be an even sized list of key value pairs" unless defined $odd;
		( my $odd_value, %params ) = @args;
		croak "Can't provide the positional param in the named list as well" if exists $params{$odd};
		$params{$odd} = $odd_value;
	} else {
		%params = @args;
	}

	return ( $self, %params );
}

sub _process_params {
	my ( $self, $params, @required ) = @_;

	foreach my $param ( @required ) {
		next if exists $params->{$param};

		$params->{$param} = $self->_process_param( $param );
	}
}

sub _process_param {
	my ( $self, $param ) = @_;

	my $default = "default_$param";

	if ( $self->can($default) ) {
		return $self->$default;
	}

	croak "No default value for required parameter '$param'";
}

sub cipher_object {
	my ( $self, %params ) = _args @_;

	$self->_process_params( \%params, qw/mode/);

	my $method = "cipher_object_" . lc(my $mode = delete $params{mode});

	croak "mode $mode is unsupported" unless $self->can($method);

	$self->$method( %params );
}

sub cipher_object_eax {
	my ( $self, %params ) = _args @_;

	$self->_process_params( \%params, qw/cipher nonce/ );

	require Crypt::EAX;

	Crypt::EAX->new(
		%params,
		cipher => "Crypt::$params{cipher}", # FIXME take a ref, but Crypt::CFB will barf
		key    => $self->process_key(%params),
		nonce  => $params{nonce},
	);
}

sub cipher_object_cbc {
	my ( $self, %params ) = _args @_;

	$self->_process_params( \%params, qw/cipher/ );

	require Crypt::CBC;

	Crypt::CBC->new(
		-cipher      => $params{cipher},
		-key         => $self->process_key(%params),
	);
}

sub cipher_object_ofb {
	my ( $self, %params ) = _args @_;

	$self->_process_params( \%params, qw/cipher/ );

	require Crypt::OFB;
	my $c = Crypt::OFB->new;

	$c->padding( Crypt::ECB::PADDING_AUTO() );

	$c->key( $self->process_key(%params) );

	$c->cipher( $params{cipher} );

	return $c;
}

sub cipher_object_cfb {
	my ( $self, @args ) = _args @_;
	require Crypt::CFB;
	$self->_cipher_object_baurem( "Crypt::CFB", @args );
}

sub cipher_object_ctr {
	my ( $self, @args ) = _args @_;
	require Crypt::Ctr;
	$self->_cipher_object_baurem( "Crypt::Ctr", @args );
}

sub _cipher_object_baurem {
	my ( $self, $class, %params ) = @_;

	my $prefix = "Crypt";
	( $prefix, $params{cipher} ) = ( Digest => delete $params{digest} ) if exists $params{encryption_digest};

	$self->_process_params( \%params, qw/cipher/ );

	$class->new( $self->process_key(%params), join("::", $prefix, $params{cipher}) );
}

use tt;
[% FOR mode IN ["stream", "block", "authenticated"] %]
sub cipher_object_[% mode %] {
	my ( $self, @args ) = _args @_;
	my $mode = $self->_process_param("[% mode %]_mode");
	$self->cipher_object( @args, mode => $mode );
}
[% END %]
no tt;

sub process_nonce {
	my ( $self, %params ) = _args @_, 'nonce';

	my $nonce = $self->_process_params( \%params, 'nonce' );

	if ( length($nonce) ) {
		return $nonce;
	} else {
		require Data::GUID;
		Data::GUID->new->as_binary;
	}
}

sub process_key {
	my ( $self, %params ) = _args @_, "key";

	if ( $params{literal_key} || $self->default_use_literal_key ) {
		$self->_process_params( \%params, qw/key/ );
		return $params{key};
	} else {
		my $size = $params{key_size};

		unless ( $size ) {
			$self->_process_params( \%params, qw/key cipher/ );
			my $cipher = $params{cipher};

			my $class = "Crypt::$cipher";

			$self->_try_loading_module($class);

			if ( my $size_method = $class->can("keysize") || $class->can("blocksize") ) {
				$size = $class->$size_method;
			}

			$size ||= $cipher eq "Blowfish" ? 56 : 32;
		}

		return $self->digest_string(
			string => $params{key},
			digest => "MultiHash",
			encode => 0,
			digest_args => [{
				width  => $size,
				hashes => ["SHA-512"], # no need to be overkill, we just need the variable width
			}],
		);
	}
}

sub digest_object {
	my ( $self, %params ) = _args @_;

	$self->_process_params( \%params, qw/
		digest
	/);

	Digest->new( $params{digest}, @{ $params{digest_args} || [] } );
}

{
	# this is a hack that gives to Digest::HMAC something that responds to ->new

	package
	Crypt::Util::HMACDigestFactory;

	sub new {
		my $self = shift;
		$$self->clone;
	}

	sub new_factory {
		my ( $self, $thing ) = @_;
		return bless \$thing, $self;
	}
}

sub mac_object {
	my ( $self, %params ) = _args @_;

	$self->_process_params( \%params, qw/
		mac
	/);

	my $mac_type = delete $params{mac};

	my $method = lc( "mac_object_$mac_type" );

	$self->$method( %params );
}

sub mac_object_hmac {
	my ( $self, @args ) = _args @_;

	my $digest = $self->digest_object(@args);

	my $digest_factory = Crypt::Util::HMACDigestFactory->new_factory( $digest );

	my $key = $self->process_key(
		literal_key => 1, # Digest::HMAC does it's own key processing, but we let the user force our own
		key_size => 64,   # if the user did force our own, the default key_size is Digest::HMAC's default block size
		@args,
	);

	require Digest::HMAC;
	Digest::HMAC->new(
		$key,
		$digest_factory,
		# FIXME hmac_block_size param?
	);
}

sub mac_object_cmac {
	my ( $self, %params ) = _args @_;

	my ( $key, $cipher );

	if ( ref $params{cipher} ) {
		$cipher = $params{cipher};
	} else {
		$self->_process_params( \%params, qw(cipher) );
		$cipher = "Crypt::" . $params{cipher};
		$key    = $self->process_key(%params);
	}

	require Digest::CMAC;
	Digest::CMAC->new( $key, $cipher );
}

use tt;
[% FOR f IN ["en", "de"] %]
sub [% f %]crypt_string {
	my ( $self, %params ) = _args @_, "string";

	my $string = delete $params{string};
	croak "You must provide the 'string' parameter" unless defined $string;

	my $c = $self->cipher_object( %params );

	[% IF f == "en" %]
	$self->maybe_encode( $c->encrypt($string), \%params );
	[% ELSE %]
	$c->decrypt( $self->maybe_decode($string, \%params ) );
	[% END %]
}

sub maybe_[% f %]code {
	my ( $self, $string, $params ) = @_;

	my $should_encode = exists $params->{[% f %]code}
		? $params->{[% f %]code}
		: exists $params->{encoding} || $self->default_encode;

	if ( $should_encode ) {
		return $self->[% f %]code_string(
			%$params,
			string   => $string,
		);
	} else {
		return $string;
	}
}
[% END %]
no tt;

sub _digest_string_with_object {
	my ( $self, $object, %params ) = @_;

	my $string = delete $params{string};
	croak "You must provide the 'string' parameter" unless defined $string;

	$object->add($string);

	$self->maybe_encode( $object->digest, \%params );
}

sub digest_string {
	my ( $self, %params ) = _args @_, "string";

	my $d = $self->digest_object( %params );

	$self->_digest_string_with_object( $d, %params );
}

sub mac_digest_string {
	my ( $self, %params ) = _args @_, "string";

	my $d = $self->mac_object( %params );

	$self->_digest_string_with_object( $d, %params );
}

sub _do_verify_hash {
	my ( $self, %params ) = _args @_;

	my $hash = delete $params{hash};
	my $fatal = delete $params{fatal};
	croak "You must provide the 'string' and 'hash' parameters" unless defined $params{string} and defined $hash;

	my $meth = $params{digest_method};

	return 1 if $hash eq $self->$meth(%params);

	if ( $fatal ) {
		croak "Digest verification failed";
	} else {
		return;
	}
}

sub verify_hash {
	my ( $self, @args ) = @_;
	$self->_do_verify_hash(@args, digest_method => "digest_string");
}

sub verify_digest {
	my ( $self, @args ) = @_;
	$self->verify_hash(@args);
}

sub verify_mac {
	my ( $self, @args ) = @_;
	$self->_do_verify_hash(@args, digest_method => "mac_digest_string");
}

{
	my @flags = qw/serialized/;

	sub _flag_hash_to_int {
		my ( $self, $flags ) = @_;

		my $bit = 1;
		my $flags_int = 0;

		foreach my $flag (@flags) {
			$flags_int |= $bit if $flags->{$flag};
		} continue {
			$bit *= 2;
		}

		return $flags_int;
	}

	sub _flag_int_to_hash {
		my ( $self, $flags ) = @_;

		my $bit =1;
		my %flags;

		foreach my $flag (@flags ) {
			$flags{$flag} = $flags & $bit;
		} continue {
			$bit *= 2;
		}

		return wantarray ? %flags : \%flags;
	}
}

sub tamper_proof {
	my ( $self, %params ) = _args @_, "data";

	$params{string} = $self->pack_data( %params );
	#$params{header} = $self->pack_data( %params, data => $params{header} ) if exists $params{header}; # FIXME this is not yet finished

	$self->tamper_proof_string( %params );
}

sub freeze_data {
	my ( $self, %params ) = @_;
	require Storable;
	Storable::nfreeze($params{data});
}

sub thaw_data {
	my ( $self, %params ) = @_;
	require Storable;
	Storable::thaw($params{data});
}

sub tamper_proof_string {
	my ( $self, %params ) = _args @_, "string";

	my $encrypted = exists $params{encrypt}
		? $params{encrypt}
		: !$self->default_tamper_proof_unencrypted;


	my $type = ( $encrypted ? "aead" : "mac" );

	my $method = "${type}_tamper_proof_string";

	my $string = $self->$method( %params );

	return $self->_pack_tamper_proof( $type => $string );
}

{
	my @tamper_proof_types = qw/mac aead/;
	my %tamper_proof_type; @tamper_proof_type{@tamper_proof_types} = 1 .. @tamper_proof_types;

	sub _pack_tamper_proof {
		my ( $self, $type, $proof ) = @_;
		pack("C a*", $tamper_proof_type{$type}, $proof);
	}

	sub _unpack_tamper_proof {
		my ( $self, $packed ) = @_;
		my ( $type, $string ) = unpack("C a*", $packed);

		return (
			($tamper_proof_types[ $type-1 ] || croak "Unknown tamper proofing method"),
			$string,
		);
	}
}

sub _authenticated_mode {
	my ( $self, $params ) = @_;

	# trust explicit param
	if ( exists $params->{authenticated_mode} ) {
		$params->{mode} = delete $params->{authenticated_mode};
		return 1;
	}

	# check if the explicit param is authenticated
	if ( exists $params->{mode} ) {
		# allow overriding
		if ( exists $params->{mode_is_authenticated} ) {
			return $params->{mode_is_authenticated};
		}

		if ( $KNOWN_AUTHENTICATING_MODES{uc($params->{mode})} ) {
			return 1;
		} else {
			return;
		}
	}

	$params->{mode} = $self->_process_param('authenticated_mode');

	return 1;
}

sub _pack_hash_and_message {
	my ( $self, $hash, $message ) = @_;
	pack("n/a* a*", $hash, $message);
}

sub _unpack_hash_and_message {
	my ( $self, $packed ) = @_;
	unpack("n/a* a*", $packed);
}

our $PACK_FORMAT_VERSION = 1;

sub pack_data {
	my ( $self, %params ) = _args @_, "data";

	$self->_process_params( \%params, qw/
		data
	/);

	my $data = delete $params{data};

	my %flags;

	if ( ref $data ) {
		$flags{serialized} = 1;
		$data = $self->freeze_data( %params, data => $data );
	}

	$self->_pack_version_flags_and_string( $PACK_FORMAT_VERSION, \%flags, $data );
}

sub unpack_data {
	my ( $self, %params ) = _args @_, "data";

	$self->_process_params( \%params, qw/
		data
	/);

	my ( $version, $flags, $data ) = $self->_unpack_version_flags_and_string($params{data});

	$self->_packed_string_version_check( $version );

	if ( $flags->{serialized} ) {
		return $self->thaw_data( %params, data => $data );
	} else {
		return $data;
	}
}

sub _pack_version_flags_and_string {
	my ( $self, $version, $flags, $string ) = @_;
	pack("n n N/a*", $version, $self->_flag_hash_to_int($flags), $string);
}

sub _unpack_version_flags_and_string {
	my ( $self, $packed ) = @_;

	my ( $version, $flags, $string ) = unpack("n n N/a*", $packed);

	$flags = $self->_flag_int_to_hash($flags);

	return ( $version, $flags, $string );
}

sub authenticated_encrypt_string {
	my ( $self, %params ) = _args @_, "string";

	# FIXME some ciphers are authenticated, but none are implemented in perl yet
	if ( $self->_authenticated_mode(\%params) ) {
		$self->_process_params( \%params, qw(nonce) );

		# generate a nonce unless one is explicitly provided
		my $nonce = $self->process_nonce(%params); # FIMXE limit to 64k?

		# FIXME safely encode an arbitrary header as well
		#my $header = $params{header};
		#$header = '' unless defined $header;

		return pack("n/a* a*", $nonce, $self->encrypt_string( %params, nonce => $nonce ) );
	} else {
		croak "To use encrypted tamper resistent strings an authenticated encryption mode such as EAX must be selected";
	}
}

sub authenticated_decrypt_string {
	my ( $self, %params ) = _args @_, "string";

	if ( $self->_authenticated_mode(\%params) ) {
		$self->_process_params( \%params, qw(string) );

		my ( $nonce, $string ) = unpack("n/a* a*", $params{string});

		return $self->decrypt_string(
			fatal => 1,
			%params,
			nonce  => $nonce,
			string => $string,
		);
	} else {
		croak "To use encrypted tamper resistent strings an authenticated encryption mode such as EAX must be selected";
	}
}

sub aead_tamper_proof_string {
	my ( $self, %params ) = _args @_, "string";

	$self->authenticated_encrypt_string( %params );
}

sub mac_tamper_proof_string {
	my ( $self, %params ) = _args @_, "string";

	my $string = delete $params{string};
	croak "You must provide the 'string' parameter" unless defined $string;

	my $hash = $self->mac_digest_string(
		%params,
		encode => 0,
		string => $string,
	);

	return $self->_pack_hash_and_message( $hash, $string );
}

sub thaw_tamper_proof_string {
	my ( $self, %params ) = _args @_, "string";

	my $string = delete $params{string};
	croak "You must provide the 'string' parameter" unless defined $string;

	my ( $type, $message ) = $self->_unpack_tamper_proof($string);

	my $method = "thaw_tamper_proof_string_$type";

	my $packed = $self->$method( %params, string => $message );
}

sub thaw_tamper_proof {
	my ( $self, %params ) = _args @_, "string";
	my $packed = $self->thaw_tamper_proof_string(%params);
	$self->unpack_data(%params, data => $packed);
}

sub thaw_tamper_proof_string_aead {
	my ( $self, %params ) = _args @_, "string";

	$self->authenticated_decrypt_string( %params );
}

sub thaw_tamper_proof_string_mac {
	my ( $self, %params ) = _args @_, "string";

	my $hashed_packed = delete $params{string};
	croak "You must provide the 'string' parameter" unless defined $hashed_packed;

	my ( $hash, $packed ) = $self->_unpack_hash_and_message( $hashed_packed );

	return unless $self->verify_mac(
		fatal  => 1,
		%params,
		hash   => $hash,
		decode => 0,
		string => $packed,
	);

	return $packed;
}

sub _packed_string_version_check {
	my ( $self, $version ) = @_;

	croak "Incompatible packed string (I'm version $PACK_FORMAT_VERSION, thawing version $version)"
		unless $version == $PACK_FORMAT_VERSION;
}

use tt;
[% FOR f IN ["en","de"] %]
sub [% f %]code_string {
	my ( $self, %params ) = _args @_, "string";

	my $string = delete $params{string};
	croak "You must provide the 'string' parameter" unless defined $string;

	$self->_process_params( \%params, qw/
		encoding
	/);

	my $encoding = delete $params{encoding};
	croak "Encoding method must be an encoding name" unless $encoding;
	my $method = "[% f %]code_string_$encoding";
	croak "Encoding method $encoding is not supported" unless $self->can($method);

	$self->$method($string);
}
[% END %]
no tt;

sub encode_string_hex {
	my ( $self, $string ) = @_;
	unpack("H*", $string);
}

sub decode_string_hex {
	my ( $self, $hex ) = @_;
	pack("H*", $hex );
}

sub encode_string_base64 {
	my ( $self, $string ) = @_;
	require MIME::Base64;
	MIME::Base64::encode_base64($string, "");
}

sub encode_string_base64_wrapped {
	my ( $self, $string ) = @_;
	require MIME::Base64;
	MIME::Base64::encode_base64($string);
}

sub decode_string_base64 {
	my ( $self, $base64 ) = @_;
	require MIME::Base64;
	MIME::Base64::decode_base64($base64);
}

# http://www.dev411.com/blog/2006/10/02/encoding-hashed-uids-base64-vs-hex-vs-base32
sub encode_string_uri_base64 {
	my ( $self, $string ) = @_;
	require MIME::Base64::URLSafe;
	MIME::Base64::URLSafe::encode($string);
}

sub decode_string_uri_base64 {
	my ( $self, $base64 ) = @_;
	require MIME::Base64::URLSafe;
	MIME::Base64::URLSafe::decode($base64);
}

sub encode_string_base32 {
	my ( $self, $string ) = @_;
	require MIME::Base32;
	MIME::Base32::encode_rfc3548($string);
}

sub decode_string_base32 {
	my ( $self, $base32 ) = @_;
	require MIME::Base32;
	MIME::Base32::decode_rfc3548(uc($base32));
}

sub encode_string_uri_escape {
	my ( $self, $string ) = @_;
	require URI::Escape;
	URI::Escape::uri_escape($string);
}

sub decode_string_uri_escape {
	my ( $self, $uri_escaped ) = @_;
	require URI::Escape;
	URI::Escape::uri_unescape($uri_escaped);
}

use tt;
[% FOR symbolic_encoding IN ["uri", "alphanumerical", "printable"] %]
[% FOR f IN ["en", "de"] %]
sub [% f %]code_string_[% symbolic_encoding %] {
	my ( $self, $string ) = @_;
	my $encoding = $self->_process_param("[% symbolic_encoding %]_encoding");
	$self->[% f %]code_string( string => $string, encoding => $encoding );
}
[% END %]
[% END %]
no tt;

sub exported_instance {
	my $self = shift;
	return $self;
}

sub __curry_instance {
	my ($class, $method_name, undef, $col) = @_;

	my $self = $col->{instance} ||= $class->__curry_flavoured_instance($col);

	sub { $self->$method_name(@_) };
}

sub __curry_flavoured_instance {
	my ( $class, $col ) = @_;

	my %params; @params{ map { "default_$_" } keys %{ $col->{defaults} } } = values %{ $col->{defaults} };

	$class->new( \%params );
}

__PACKAGE__;

__END__