view release on metacpan or  search on metacpan

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

	package TestApp;

	use strict;
	use warnings;

	use Catalyst qw/EncryptID/;

	TestApp->config(
		name    => 'TestApp',
		EncryptID => {
			secret => 'abc123xyz',
			padding_character => '!'
		}
	);

	1;

In Controller

	package TestApp::Controller::Root;
	use base 'Catalyst::Controller';

	__PACKAGE__->config->{namespace} = '';

	sub index : Private {
	    my ( $self, $c ) = @_;
	    $c->res->body('root index');
	}

	sub encrypt : Global Args(1) {
	    my ( $self, $c, $id ) = @_;
	    my $encripted_hash = $c->encrypt_data($id);
	    ...
	}

	sub decrypt : Global Args(1) {
	    my ( $self, $c, $hashid ) = @_;
	    my $decrypted_string = $c->decrypt_data($hashid);
	    ...
	}

	sub validhash : Global Args(1) {
	    my ( $self, $c, $hashid ) = @_;
	    my $status = $c->is_valid_encrypt_hash($hashid);
	    ...
	}

	1;

=head1 EXPORT

A list of functions that can be exported.  You can delete this section
if you don't export anything, such as for a purely object-oriented module.

=head1 SUBROUTINES/METHODS

=head2 encrypt_data

C<encrypt_data(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

sub encrypt_data {
	my( $c, $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 = _padding_character($c) 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 = ( _padding_character($c) x ($left % $min_length) ). $sub_text;
		};

		my $ciphertext = _cipher($c)->encrypt($sub_text);
		$ciphertext_hash .= unpack('H16', $ciphertext ) ;
	}

	return $ciphertext_hash;
}

=head2 decrypt_data

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

=cut

sub decrypt_data {
	my( $c, $encrypted_hash ) = @_;

	return unless is_valid_encrypt_hash( $c, $encrypted_hash );

	my $padding_character = _padding_character($c);
	my $ciphertext = '';

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

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

=head2 is_valid_encrypt_hash

C<is_valid_encrypt_hash(HASH)> - Return true if given encrypt has is valid