Generated tokens pass Luhn check, and avoid collission

diff --git a/lib/Business/OnlinePayment/Bambora.pm b/lib/Business/OnlinePayment/Bambora.pm
index 98c402f..d85c2c2 100755 (executable)
--- a/lib/Business/OnlinePayment/Bambora.pm
+++ b/lib/Business/OnlinePayment/Bambora.pm
@@ -614,26 +614,45 @@ customer_code.
 
 sub generate_token {
   my $self = shift;
-  my $time = Time::HiRes::time();
 
-  $time =~ s/\D//g;
-  $time = substr($time, 0, 14 ); # Eventually time() will contain 15 digits
-
-  "99$time";
+  # Pull the current time, to the micro-second from Time::HiRes
+  # Reverse the time string, so when trimed to 13 digits, the most
+  # significant digits, the microseconds, are preserved
+  #
+  # Collission testing:
+  #   If a collission were to occur, two Bambora payment profiles would
+  # be created with the same customer_number token. This would result in
+  # both payment profiles declining transactions.
+  #    I generated 1,000,000 tokens with this method in 18 seconds.
+  # and they were all unique. I think the risk of collission is minimal.
+  # If this did become a problem for somebody, a time delay could be added
+  # to this method to eliminate the change of collisions:
+  #
+  # sleep(1); 
+
+  my $timestr =
+    join '' =>
+       grep { /\d/ }
+       reverse
+       split //, sprintf '%.5f', Time::HiRes::time();
+  my $token = 99 . substr( $timestr, 0, 13 );
+  my @token = split //, $token;
+
+  # Generate Luhn checksum digit
+  my $sum = 0;
+  for my $i ( 0..14 ) {
+    if ( $i % 2 ) {
+      $sum += $token[$i];
+    } else {
+      my $j = $token[$i]*2;
+      $j -= 9 if $j > 9;
+      $sum += $j;
+    }
 }
 
-=head2 set_country
-
-Country is expected to be set as an ISO-3166-1 2-letter country code
-
-Sets string to upper case.
-
-Dies unless country is a two-letter string.
-
-Could be extended to convert country names to their respective
-country codes, or validate country codes
-
-See: L<https://en.wikipedia.org/wiki/ISO_3166-1>
+  my $luhn =  $sum % 10 ? 10 - ( $sum % 10 ) : 0;
+  return $token . $luhn;
+}
 
 =cut