view release on metacpan or  search on metacpan

lib/Dancer2/Plugin/EncryptID.pm  view on Meta::CPAN

	default => sub {
		my $self = shift;
		return $self->config->{padding_character} || '!';
	}
);

has cipher => (
    is => 'ro',
    lazy => 1,
    default => sub {
    	my $self = shift;
        return Crypt::Blowfish->new($self->secret);
    }
);

=head1 SYNOPSIS

    package MyApp;

    use strict;
    use warnings;

    use Dancer2;

    BEGIN { # would usually be in config.yml
        set plugins => {
            EncryptID => {
                secret => 'abc123xyz',
                padding_character => '!'
            },
        };
    }

    use Dancer2::Plugin::EncryptID;

    get '/' => sub {

		# Any ID (numeric or alpha-numeric) you want to obfuscate
		my $someid = int(rand(42)+1);

		my $encoded_id = dancer_encrypt($someid);
		my $url = request->uri_for("/item/$encoded_id");
    };

    get '/item/:encoded_id' => sub {

		# Decode the ID back to clear-text
		my $item_id = dancer_decrypt( params->{encoded_id} ) ;

		return "Showing item '$item_id'";
    };

    1;

=head1 SUBROUTINES/METHODS

=head2 dancer_encrypt

C<dancer_encrypt(ID [,PREFIX])> - Encrypt the given ID, returns the encoded hash value.
			     If "PREFIX" is given, it will be added to the ID before encoding.
			     It can be used when decoding to verify the decoded value is valid.

=cut

plugin_keywords 'dancer_encrypt';

sub dancer_encrypt {
	my( $plugin, $text, $prefix ) = @_;

	warn "Missing Clear text ID parameter" unless defined $text;
	return unless defined $text;

	## Prefix is optional, can be undef
	$text = $prefix . $text if defined $prefix;

	my $min_length = 8;
	my $ciphertext_hash = '';

	#encode an empty string
	$text = $plugin->padding_character x $min_length if length($text) < 1;

	while ( length($text) > 0 ) {
		my $sub_text = substr($text,0,$min_length,'');
		if ( length($sub_text) < 8 ) {
			my $left = $min_length - length($sub_text);
			$sub_text = ( $plugin->padding_character x ($left % $min_length) ). $sub_text;
		};

		my $ciphertext = $plugin->cipher->encrypt($sub_text);
		$ciphertext_hash .= unpack('H16', $ciphertext ) ;
	}
	return $ciphertext_hash;
}

=head2 dancer_decrypt

C<dancer_decrypt(ID)> - Decrypt the given ID, returns the original (text) ID value.

=cut

plugin_keywords 'dancer_decrypt';

sub dancer_decrypt {
	my( $plugin, $encrypted_hash ) = @_;

	return unless $plugin->is_valid_encrypt_hash($encrypted_hash);

	my $padding_character = $plugin->padding_character;
	my $ciphertext = '';

	while ( length($encrypted_hash) > 0 ) {
		my $sub_text   = substr($encrypted_hash,0,16,'');
		my $cipherhash = pack('H16', $sub_text );
		my $text = $plugin->cipher->decrypt($cipherhash);

		$text =~ s/^$padding_character+//;
		$ciphertext .= $text;
	};
	return $ciphertext
}