Algorithm-CouponCode
view release on metacpan or search on metacpan
dist.ini
html/cc_icons.png
html/index.html
html/jquery.couponcode.css
html/jquery.couponcode.js
html/style.css
lib/Algorithm/CouponCode.pm
t/00-load.t
t/01-generate.t
t/02-bad-regex.t
t/03-validate.t
t/04-transposition.t
t/release-pod-coverage.t
t/release-pod-syntax.t
{
"abstract" : "Generate and validate 'CouponCode' strings",
"author" : [
"Grant McLean <grantm@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 5.022, CPAN::Meta::Converter version 2.142690",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
---
abstract: "Generate and validate 'CouponCode' strings"
author:
- 'Grant McLean <grantm@cpan.org>'
build_requires:
Test::More: 0.88
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 0
generated_by: 'Dist::Zilla version 5.022, CPAN::Meta::Converter version 2.142690'
license: perl
meta-spec:
Makefile.PL view on Meta::CPAN
use strict;
use warnings;
use 5.010;
use ExtUtils::MakeMaker;
my %WriteMakefileArgs = (
"ABSTRACT" => "Generate and validate 'CouponCode' strings",
"AUTHOR" => "Grant McLean <grantm\@cpan.org>",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => 0
},
"DISTNAME" => "Algorithm-CouponCode",
"EXE_FILES" => [],
"LICENSE" => "perl",
"MIN_PERL_VERSION" => "5.010",
"NAME" => "Algorithm::CouponCode",
"PREREQ_PM" => {
This archive contains the distribution Algorithm-CouponCode,
version 1.005:
Generate and validate 'CouponCode' strings
This software is copyright (c) 2011 by Grant McLean.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
This README file was generated by Dist::Zilla::Plugin::Readme v5.022.
html/jquery.couponcode.js view on Meta::CPAN
var inner = $('<span class="jq-couponcode-inner" />');
for(var i = 0; i < self.parts; i++) {
if(i > 0) {
inner.append($('<span class="jq-couponcode-sep" />').text(self.separator));
}
self.inputs[i] = $('<input type="text" class="jq-couponcode-part" />');
inner.append(self.inputs[i]);
}
$( self.inputs ).each(function(i, input) {
input
.keydown(function() { setTimeout(function() { validate(i); }, 5 ); } )
.blur(function() { self.focus = null; validate(i); } )
.focus( function() { self.focus = i; } );
});
self.inputs[0].on('paste', function() {
setTimeout(function() { set_parts(self.inputs[0].val()); }, 2);
});
if(start_val.length > 0) {
set_parts(start_val);
}
wrapper.append(inner);
if(self.setFocus) {
self.inputs[0].focus();
}
function set_parts(code) {
var parts = code.split('-');
for(var i = 0; i < self.parts; i++) {
self.inputs[i].val( parts[i] || '');
validate(i);
}
}
function validate(index) {
var input = self.inputs[index];
var result = validate_one_field(input, index);
if(result === true) {
input.removeClass('jq-couponcode-bad');
input.addClass('jq-couponcode-good');
self.flags[index] = 1;
}
else {
input.removeClass('jq-couponcode-good');
input.removeClass('jq-couponcode-bad');
if(result === false) {
input.addClass('jq-couponcode-bad');
}
self.flags[index] = 0;
}
update_hidden_field();
}
function validate_one_field(input, index) {
var val = input.val();
var focussed = (self.focus === index);
if(val == '') { return; }
var code = clean_up( val );
if(code.length > 4 || BAD_SYMBOL.test(code)) {
return false;
}
if(code.length < 4) {
return focussed ? null : false;
}
lib/Algorithm/CouponCode.pm view on Meta::CPAN
package Algorithm::CouponCode;
$Algorithm::CouponCode::VERSION = '1.005';
=head1 NAME
Algorithm::CouponCode - Generate and validate 'CouponCode' strings
=cut
use 5.010;
use warnings;
use strict;
use Exporter qw(import);
use Digest::SHA qw(sha1);
our @EXPORT_OK = qw(cc_generate cc_validate make_bad_regex);
my $sym_str = '0123456789ABCDEFGHJKLMNPQRTUVWXY';
my @sym = split //, $sym_str;
my $urandom_path = '/dev/urandom';
my $have_urandom = -r $urandom_path;
my $bad_regex = make_bad_regex();
sub cc_generate {
my %arg = @_;
lib/Algorithm/CouponCode.pm view on Meta::CPAN
next TRY_PART if $part =~ $bad_words;
next TRY_PART if _valid_when_swapped($part, $i);
push @code, $part;
}
}
return join '-', @code;
}
sub cc_validate {
my %arg = @_;
my $code = $arg{code} or return;
my $parts = $arg{parts} // 3;
$code = uc($code);
$code =~ s{[^0-9A-Z]+}{}g;
$code =~ tr{OIZS}{0125};
my(@parts) = $code =~ m{([0-9A-Z]{4})}g;
return unless scalar(@parts) == $parts;
lib/Algorithm/CouponCode.pm view on Meta::CPAN
return 0;
}
1;
__END__
=pod
=head1 SYNOPSIS
use Algorithm::CouponCode qw(cc_generate cc_validate);
print cc_generate(parts => 3); # generate a 3-part code
my $valid_code = cc_validate(code => $code, parts => 3) or die "Invalid code";
=head1 DESCRIPTION
A 'Coupon Code' is made up of letters and numbers grouped into 4 character
'parts'. For example, a 3-part code might look like this:
1K7Q-CTFM-LMTC
Coupon Codes are random codes which are easy for the recipient to type
accurately into a web form. An example application might be to print a code on
lib/Algorithm/CouponCode.pm view on Meta::CPAN
skipped. Any generated part which happens to spell an 'inappropriate' 4-letter
word (e.g.: 'P00P') will also be skipped.
=back
The Algorithm-CouponCode distribution includes a Javascript implementation of
the validator function, in the form of a jQuery plugin. You can include this
in your web application to do client-side validation and highlighting of
errors.
I<Note> the cc_validate function and the Javascript plugin only validate that
the code is 'well-formed' (i.e.: each part has a valid checkdigit). Checking
whether the code is in fact 'valid' is left up to your application and would
typically involve looking for the code in a database. If you use the
Javascript plugin, you might choose to tweak the CSS to keep the red
highlighting of checksum errors but remove the green highlighting which might
imply the code was correct.
=head2 Randomness and Uniqueness
The code returned by C<cc_generate()> is random, but not necessarily unique.
lib/Algorithm/CouponCode.pm view on Meta::CPAN
you.
=item bad_regex
You can supply a regular expression for matching 4-letter words which should
not appear in generated output. The C<make_bad_regex()> helper function can
be used to turn a list of words into a suitable regular expression.
=back
=head2 cc_validate( options )
Takes a code, cleans it up and validates the checkdigits. Returns the
normalised (and untainted) version of the code on success or undef on error.
The following named parameters may be supplied:
=over 4
=item code
The code to be validated. The parameter is mandatory.
=item parts
The number of parts you expect the code to contain. Default is 3.
=back
=head2 make_bad_regex( options )
This function is used to compile a list of 4-letter words into a regular
t/03-validate.t view on Meta::CPAN
#!perl -T
use strict;
use warnings;
use Test::More;
use Algorithm::CouponCode qw(cc_validate);
can_ok(__PACKAGE__, 'cc_validate');
ok(!cc_validate(), 'missing code failed validation');
ok( cc_validate(code => '1K7Q-CTFM-LMTC'), 'valid code was accepted');
ok(!cc_validate(code => '1K7Q-CTFM'), 'short code was rejected');
ok( cc_validate(code => '1K7Q-CTFM', parts => 2),
"but accepted with correct 'parts'");
ok(!cc_validate(code => 'CTFM-1K7Q', parts => 2),
"parts must be in correct order");
is( cc_validate(code => '1k7q-ctfm-lmtc'), '1K7Q-CTFM-LMTC',
"lowercase code is fixed and valid");
is(cc_validate(code => 'I9oD-V467-8D52'), '190D-V467-8D52', "'o' is fixed to '0'");
is(cc_validate(code => 'I9oD-V467-8D52'), '190D-V467-8D52', "'O' is fixed to '0'");
is(cc_validate(code => 'i9oD-V467-8D52'), '190D-V467-8D52', "'i' is fixed to '1'");
is(cc_validate(code => 'i9oD-V467-8D52'), '190D-V467-8D52', "'I' is fixed to '1'");
is(cc_validate(code => 'i9oD-V467-8D5z'), '190D-V467-8D52', "'z' is fixed to '2'");
is(cc_validate(code => 'i9oD-V467-8D5z'), '190D-V467-8D52', "'Z' is fixed to '2'");
is(cc_validate(code => 'i9oD-V467-8Dsz'), '190D-V467-8D52', "'s' is fixed to '5'");
is(cc_validate(code => 'i9oD-V467-8Dsz'), '190D-V467-8D52', "'S' is fixed to '5'");
is(cc_validate(code => 'i9oD/V467/8Dsz'), '190D-V467-8D52',
"alternative separator is accepted and fixed");
is(cc_validate(code => ' i9oD V467 8Dsz '), '190D-V467-8D52',
"whitespace is accepted and fixed");
is(cc_validate(code => ' i9oD_V467_8Dsz '), '190D-V467-8D52',
"underscores are accepted and fixed");
is(cc_validate(code => 'i9oDV4678Dsz'), '190D-V467-8D52',
"no separator is required");
ok( cc_validate(code => '1K7Q', parts => 1), 'valid code-pretest');
ok(!cc_validate(code => '1K7C', parts => 1),
'invalid checkdigit was rejected in part 1');
ok( cc_validate(code => '1K7Q-CTFM', parts => 2), 'valid code-pretest');
ok(!cc_validate(code => '1K7Q-CTFW', parts => 2),
'invalid checkdigit was rejected in part 2');
ok( cc_validate(code => '1K7Q-CTFM-LMTC', parts => 3), 'valid code-pretest');
ok(!cc_validate(code => '1K7Q-CTFM-LMT1', parts => 3),
'invalid checkdigit was rejected in part 3');
ok( cc_validate(code => '7YQH-1FU7-E1HX-0BG9', parts => 4),
'valid code-pretest');
ok(!cc_validate(code => '7YQH-1FU7-E1HX-0BGP', parts => 4),
'invalid checkdigit was rejected in part 4');
ok( cc_validate(code => 'YENH-UPJK-PTE0-20U6-QYME', parts => 5),
'valid code-pretest');
ok(!cc_validate(code => 'YENH-UPJK-PTE0-20U6-QYMT', parts => 5),
'invalid checkdigit was rejected in part 5');
ok( cc_validate(code => 'YENH-UPJK-PTE0-20U6-QYME-RBK1', parts => 6),
'valid code-pretest');
ok(!cc_validate(code => 'YENH-UPJK-PTE0-20U6-QYME-RBK2', parts => 6),
'invalid checkdigit was rejected in part 6');
done_testing;
t/04-transposition.t view on Meta::CPAN
#!perl -T
use strict;
use warnings;
use Test::More;
use Algorithm::CouponCode qw(cc_validate cc_generate);
foreach my $i (1..1000) {
my $code = cc_generate(parts => 1);
my $label = sprintf("transposition test %04u '%s' =>", $i, $code);
my($a, $b, $c, $d) = split //, $code;
ok( cc_validate(code => "$a$b$c$d", parts => 1),
"$label '$a$b$c$d' is valid");
foreach my $trans ( "$b$a$c$d", "$a$c$b$d", "$a$b$d$c" ) {
next if $trans eq $code; # swapped characters were the same
ok(!cc_validate(code => $trans, parts => 1),
"$label '$trans' is not valid");
}
}
done_testing;
( run in 0.291 second using v1.01-cache-2.11-cpan-a5abf4f5562 )