Algorithm-CheckDigits-0.50/0000755000175000017500000000000011022312327015372 5ustar mathiasmathiasAlgorithm-CheckDigits-0.50/t/0000755000175000017500000000000011022312327015635 5ustar mathiasmathiasAlgorithm-CheckDigits-0.50/t/valid.data0000644000175000017500000001535311013473143017602 0ustar mathiasmathiasuse vars qw(@testcases); @testcases = ( # M007 [ 'ismn', 'M-345-24680-5', 'M-345-24680', '5', 'M-345-24689-0' ], # M011 [ 'upc', '012345678905', '01234567890', '5', '012345678901' ], # M012 [ 'sedol', '0123457', '012345', '7', '0123456' ], # M013 [ 'postcheckkonti', '85-12345678-7', '85-12345678-', '7', '85-12345678-9' ], # M014 [ 'isbn', '3-88229-192-3', '3-88229-192-', '3', '3-88229-192-0' ], [ 'issn', '0724-8679', '0724-867', '9', '0724-8870' ], [ 'ustid_pt', '136695973', '13669597', '3', '136695970' ], [ 'hkid', 'K1234560', 'K123456', '0', 'K1234567' ], [ 'wagonnr_br', '123456-1', '123456-', '1', '123456-7' ], [ 'nhs_gb', '3882291850', '388229185', '0', '3882291851' ], [ 'vat_sl', '59082437', '5908243', '7', '59082432' ], # M015 [ 'pzn', '4877800', '487780', '0', '4877801' ], # MBase-002 [ 'blutbeutel', '2761011234567893', '276101123456789', '3', '2761011234567890' ], [ 'blutbeutel', '02', '0', '2', '01' ], [ 'blutbeutel', '19', '1', '9', '10' ], [ 'blutbeutel', '60', '6', '0', '61' ], [ 'blutbeutel', '94', '9', '4', '90' ], [ 'blutbeutel', '08235', '0823', '5', '08234' ], [ 'blutbeutel', '2766169732125615', '276616973212561', '5', '2766169732125610' ], [ 'bzue_de', '9433463951409', '943346395140', '9', '9433463951400' ], [ 'ustid_de', '136 695 976', '136 695 97', '6', '136 695 970' ], # MBase-003 [ 'sici', '0724-8679(20040308)6:<138>2.0.TX;2-H', '0724-8679(20040308)6:<138>2.0.TX;2-', 'H', '0724-8679(20040308)6:<138>2.0.TX;2-A', ], # M07-001 [ 'm07-001', '0', '', '0', '1' ], [ 'm07-001', '1234567892', '123456789', '2', '1234567890' ], # M09-001 [ 'euronote', 'X03854465012', 'X0385446501', '2', 'X03854465010' ], [ 'euronote', 'P02044163566', 'P0204416356', '6', 'P02044163560' ], # M10-001 [ 'amex', '3400 000000 00009', '3400 000000 0000', '9', '3400 000000 00000' ], [ 'diners', '3000 0000 0000 04', '3000 0000 0000 0', '4', '3000 0000 0000 00' ], [ 'diners', '3600 0000 0000 08', '3600 0000 0000 0', '8', '3600 0000 0000 00' ], [ 'discover', '6011 0000 0000 0004', '6011 0000 0000 000', '4', '6011 0000 0000 0000' ], [ 'enroute', '2014 0000 0000 009', '2014 0000 0000 00', '9', '2014 0000 0000 000' ], [ 'jcb', '3088 0000 0000 0009', '3088 0000 0000 000', '9', '3038 0000 0000 0001' ], [ 'mastercard', '5500 0000 0000 0004', '5500 0000 0000 000', '4', '5500 0000 0000 0000' ], [ 'visa', '4111 1111 1111 1111', '4111 1111 1111 111', '1', '4111 1111 1111 1110' ], [ 'isin', 'DE0005557508', 'DE000555750', '8', 'DE0005557509' ], # M10-002 # the test number from www.pruefziffernberechnung.de seems to be # invalid # [ 'siret', '12345678200787', '1234567820078', '7' ], [ 'siren', '732 829 320', '732 829 32', '0', '732 829 321' ], [ 'siret', '73282932000074', '7328293200007', '4', '73282932000070' ], # M10-004 [ 'ean', '7622200004607', '762220000460', '7', '7622200004600' ], [ 'isbn13', '9783492233163', '978349223316', '3', '9783492233160' ], [ '2aus5', '1234565', '123456', '5', '1234567' ], [ 'isbn13', '9783882291858', '978388229185', '8', '9783882291851' ], # M10-005 [ 'identcode_dp', '21.802 580.906 6', '21.802 580.906 ', '6', '21.802 580.906 0' ], # M10-006 [ 'rentenversicherung', '65180539W001', '65180539W00', '1', '65180539W000' ], # M10-009 [ 'betriebsnummer', '09912342', '0991234', '2', '09912340' ], # M005 [ 'ups', '1Z 591580 68 55587736', '1Z 591580 68 5558773', '6', '1Z 591580 68 55587730' ], # M11-003 [ 'pkz', '150765400354', '15076540035', '4', '150765400350' ], [ 'pkz', '110488414857', '11048841485', '7', '110488414850' ], # M11-004 [ 'cpf', '043.033.407-90', '043.033.407-', '90', '043.033.407-91' ], [ 'titulo_eleitor', '181497628-60', '181497628-', '60', '181497628-61' ], # M11-006 [ 'ccc_es', '2420-0730-27-0050103552', '2420-0730- -0050103552', '27', '2420-0730-20-0050103552' ], # M11-007 [ 'ustid_fi', '13669598', '1366959', '8', '13669590' ], # M11-008 [ 'ustid_dk', '13585628', '13585628', '', '13585620' ], # M11-009 [ 'nric_sg', 'S1234567D', 'S1234567', 'D', 'S1234567A' ], # M11-016 [ 'ustid_pl', '8567349219', '856734921', '9', '8567349210' ], # M11-010 [ 'ahv_ch', '123.45.678.113', '123.45.678.11', '3', '123.45.678.110' ], # M11-011 [ 'ustid_nl', '123456782', '12345678', '2', '123456783' ], [ 'ustid_nl', '007677595B04', '00767759.B04', '5', '007677593B04' ], # M11-012 [ 'bwpk_de', '151058-D-20711', '151058-D-2071', '1', '151058-D-20712' ], # M11-013 [ 'ustid_gr', '123456783', '12345678','3', '123456789' ], # M11-015 [ 'esr5_ch', '123456785', '12345678', '5', '123456789' ], # M11-017 [ 'ecno', '200-235-0', '200-235-', '0', '200-235-1' ], # M16-001 [ 'isan', '123A567B8912E01A', '123A567B8912E01', 'A', '123A567B8912E01B' ], # M23-001 [ 'dni_es', '54362315-K', '54362315-', 'K', '54362315-A' ], # M23-002 [ 'ustid_ie', '8473625E', '8473625', 'E', '8473625A' ], # M43-001 [ 'code_39', 'AB-123K', 'AB-123', 'K', 'AB-123A' ], # M89-001 [ 'ustid_lu', '13669580', '136695', '80', '13669581' ], # M97-001 [ 'ustid_be', '136695962', '1366959', '62', '136695960' ], # M97-002 [ 'iban', 'DE88 2008 0000 09703 7570 0', 'DE00 2008 0000 09703 7570 0', '88', 'DE12 2008 0000 09703 7570 0' ], # MXX-001 [ 'pa_de', '2406055684D<6810203<0705109<6', '240605568_D<681020_<070510_<_', '4<3<9<6', '2406055684D<6810203<0705109<4' ], # MXX-002 [ 'cas', '1333-74-0', '1333-74-', '0', '1333-74-1' ], [ 'cas', '107-07-3', '107-07-', '3', '107-07-1' ], [ 'cas', '1021205-92-4', '1021205-92-', '4', '1021205-92-1' ], # MXX-003 [ 'dem', 'GD0645027K1', 'GD0645027K', '1', 'GD0645027K0' ], # MXX-004 [ 'ustid_at', 'U13585627', 'U1358562', '7', 'U13585620' ], # MXX-005 [ 'esr9_ch', '123456786', '12345678', '6', '123456789' ], # MXX-006 [ 'verhoeff', '14567894', '1456789', '4', '14657894' ], ); Algorithm-CheckDigits-0.50/t/valid.t0000644000175000017500000000245511013473143017133 0ustar mathiasmathias# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use vars qw(@testcases); use Test; BEGIN { do 't/valid.data'; plan(tests => ($#testcases + 1) * 5 # ,todo => [ 76, ] ); }; use Algorithm::CheckDigits; my $checkdigit; foreach my $tcase (@testcases) { #foreach my $tcase ($testcases[$#testcases]) { if ($checkdigit = CheckDigits($tcase->[0])) { my $is_valid = $checkdigit->is_valid($tcase->[1]); ok($is_valid ,1 ,"is_valid $tcase->[0]" ); my $skip = not $is_valid; skip($skip ,$checkdigit->complete($tcase->[2]) ,$tcase->[1] ,"complete $tcase->[0]" ); skip($skip ,$checkdigit->basenumber($tcase->[1]) ,$tcase->[2] ,"basenumber $tcase->[0]" ); skip($skip ,$checkdigit->checkdigit($tcase->[1]) ,$tcase->[3] ,"checkdigit $tcase->[0]" ); skip($skip ,(not $checkdigit->is_valid($tcase->[4])) ,1 ,"not is_valid $tcase->[0]: $tcase->[4]" ); } } ######################### # Insert your test code below, the Test module is use()ed here so read # its man page ( perldoc Test ) for help writing this test script. Algorithm-CheckDigits-0.50/t/iban.t0000644000175000017500000000457411013473143016751 0ustar mathiasmathiasuse Test; BEGIN { plan(tests => 44); }; use Algorithm::CheckDigits; my $iban = CheckDigits('iban'); # ok($iban->is_valid("AD12 0001 2030 2003 5910 0100")); ok($iban->is_valid("BE68 5390 0754 7034")); ok($iban->is_valid("BA39 1290 0794 0102 8494")); ok($iban->is_valid("BG80 BNBG 9661 1020 3456 78")); ok($iban->is_valid("DK50 0040 0440 1162 43")); ok($iban->is_valid("DE89 3704 0044 0532 0130 00")); ok($iban->is_valid("EE38 2200 2210 2014 5685")); ok($iban->is_valid("FI21 1234 5600 0007 85")); ok($iban->is_valid("FO97 5432 0388 8999 44")); ok($iban->is_valid("FR14 2004 1010 0505 0001 3M02 606")); ok($iban->is_valid("GI75 NWBK 0000 0000 7099 453")); ok($iban->is_valid("GR16 0110 1250 0000 0001 2300 695")); ok($iban->is_valid("GL56 0444 9876 5432 10 ")); ok($iban->is_valid("GB29 NWBK 6016 1331 9268 19")); ok($iban->is_valid("IE29 AIBK 9311 5212 3456 78")); ok($iban->is_valid("IS14 0159 2600 7654 5510 7303 39")); ok($iban->is_valid("IT60 X054 2811 1010 0000 0123 456")); ok($iban->is_valid("HR12 1001 0051 8630 0016 0")); ok($iban->is_valid("LV80 BANK 0000 4351 9500 1")); ok($iban->is_valid("LT12 1000 0111 0100 1000")); ok($iban->is_valid("LI21 0881 0000 2324 013A A")); ok($iban->is_valid("LU28 0019 4006 4475 0000")); ok($iban->is_valid("MK07 3000 0000 0042 425")); ok($iban->is_valid("MT84 MALT 0110 0001 2345 MTLC AST0 01S")); ok($iban->is_valid("MU56 BOMM 0101 1234 5678 9101 0000 00")); ok($iban->is_valid("MC93 2005 2222 1001 1223 3M44 555")); ok($iban->is_valid("NL91 ABNA 0417 1643 00")); ok($iban->is_valid("NO93 8601 1117 947")); ok($iban->is_valid("AT61 1904 3002 3457 3201")); ok($iban->is_valid("PL27 1140 2004 0000 3002 0135 5387")); ok($iban->is_valid("PT50 0002 0123 1234 5678 9015 4")); ok($iban->is_valid("RO49 AAAA 1B31 0075 9384 0000")); ok($iban->is_valid("SM62 Y054 3219 8760 0444 5333 222")); ok($iban->is_valid("CS73 2600 0560 1001 6113 79")); ok($iban->is_valid("SE35 5000 0000 0549 1000 0003")); ok($iban->is_valid("CH93 0076 2011 6238 5295 7")); ok($iban->is_valid("SK31 1200 0000 1987 4263 7541")); ok($iban->is_valid("SI56 1910 0000 0123 438")); ok($iban->is_valid("ES91 2100 0418 4502 0005 1332")); ok($iban->is_valid("CZ65 0800 0000 1920 0014 5399")); ok($iban->is_valid("TN59 1420 7207 1007 0712 9648")); ok($iban->is_valid("TR33 0006 1005 1978 6457 8413 26 ")); ok($iban->is_valid("HU42 1177 3016 1111 1018 0000 0000")); ok($iban->is_valid("CY17 0020 0128 0000 0012 0052 7600")); Algorithm-CheckDigits-0.50/t/isbn13.t0000644000175000017500000000077211013473143017133 0ustar mathiasmathiasuse Test; BEGIN { plan ( tests => 4, # todo => [3], ); }; use Algorithm::CheckDigits; my $isbn13 = CheckDigits('isbn13'); my $ean = CheckDigits('ean'); my $isbn_number = "9783492233163"; my $ean_but_not_isbn_number = "7622200004607"; ok($isbn13->is_valid($isbn_number),1, "valid ISBN"); ok($ean->is_valid( $isbn_number),1, "valid EAN"); ok($isbn13->is_valid($ean_but_not_isbn_number),'', "valid EAN but not ISBN"); ok($ean->is_valid( $ean_but_not_isbn_number),1, "valid EAN"); Algorithm-CheckDigits-0.50/t/ecno.t0000644000175000017500000000110711013473143016751 0ustar mathiasmathiasuse Test; BEGIN { plan(tests => 13); }; use Algorithm::CheckDigits; my $ecno = CheckDigits('ECNo'); # ok(not $ecno->is_valid("200-001-0")); ok(not $ecno->is_valid("200-001-1")); ok(not $ecno->is_valid("200-001-2")); ok(not $ecno->is_valid("200-001-3")); ok(not $ecno->is_valid("200-001-4")); ok(not $ecno->is_valid("200-001-5")); ok(not $ecno->is_valid("200-001-6")); ok(not $ecno->is_valid("200-001-7")); ok($ecno->is_valid("200-001-8")); ok(not $ecno->is_valid("200-001-9")); ok($ecno->is_valid("220-001-1")); ok($ecno->is_valid("230-001-3")); ok($ecno->is_valid("310-001-0")); Algorithm-CheckDigits-0.50/t/upc.t0000644000175000017500000000041711013473143016617 0ustar mathiasmathiasuse Test; BEGIN { plan(tests => 1); }; use Algorithm::CheckDigits; my $upc = CheckDigits('upc'); # there was an error exposed with that number, so I include it here to # avoid making that error again. # # Thanks to Aaron W. West # ok($upc->is_valid("724358016420")); Algorithm-CheckDigits-0.50/t/imei.t0000644000175000017500000000066611013473143016761 0ustar mathiasmathiasuse Test; BEGIN { plan(tests => 5); }; use Algorithm::CheckDigits; my $imei = CheckDigits('IMEI'); # ok($imei->is_valid("260531793113837")); ok(not $imei->is_valid("260531793113838")); # you have to use method 'imeisv' if your number contains the software version ok(not $imei->is_valid("26053179311383347")); my $imeisv = CheckDigits('IMEISV'); ok($imeisv->is_valid("26053179311383127")); ok($imeisv->is_valid("26053179311383347")); Algorithm-CheckDigits-0.50/t/pod-coverage.t0000644000175000017500000000032611013473143020402 0ustar mathiasmathiasuse Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; my $trustme = { trustme => [qr/^new$/] }; all_pod_coverage_ok( $trustme ); Algorithm-CheckDigits-0.50/t/pod.t0000644000175000017500000000020111013473143016601 0ustar mathiasmathiasuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Algorithm-CheckDigits-0.50/t/checkdigits.t0000644000175000017500000000072211013473143020310 0ustar mathiasmathias# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test; BEGIN { plan tests => 1 }; use Algorithm::CheckDigits; ok(1); ######################### # Insert your test code below, the Test module is use()ed here so read # its man page ( perldoc Test ) for help writing this test script. Algorithm-CheckDigits-0.50/CheckDigits.pm0000644000175000017500000003636711022311656020134 0ustar mathiasmathias# vim: ts=4 sw=4 tw=78 et si: package Algorithm::CheckDigits; use 5.006; use strict; use warnings; use Carp; use vars qw($AUTOLOAD); require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use CheckDigits ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( CheckDigits method_list print_methods ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( CheckDigits ); our $VERSION = '0.50'; my %methods = ( 'mbase-001' => 'Algorithm::CheckDigits::MBase_001', 'upc' => 'Algorithm::CheckDigits::MBase_001', 'mbase-002' => 'Algorithm::CheckDigits::MBase_002', 'blutbeutel' => 'Algorithm::CheckDigits::MBase_002', 'bzue_de' => 'Algorithm::CheckDigits::MBase_002', 'ustid_de' => 'Algorithm::CheckDigits::MBase_002', 'vatrn_de' => 'Algorithm::CheckDigits::MBase_002', 'mbase-003' => 'Algorithm::CheckDigits::MBase_003', 'sici' => 'Algorithm::CheckDigits::MBase_003', 'm07-001' => 'Algorithm::CheckDigits::M07_001', 'm09-001' => 'Algorithm::CheckDigits::M09_001', 'euronote' => 'Algorithm::CheckDigits::M09_001', 'm10-001' => 'Algorithm::CheckDigits::M10_001', 'amex' => 'Algorithm::CheckDigits::M10_001', 'bahncard' => 'Algorithm::CheckDigits::M10_001', 'diners' => 'Algorithm::CheckDigits::M10_001', 'discover' => 'Algorithm::CheckDigits::M10_001', 'enroute' => 'Algorithm::CheckDigits::M10_001', 'eurocard' => 'Algorithm::CheckDigits::M10_001', 'happydigits' => 'Algorithm::CheckDigits::M10_001', 'jcb' => 'Algorithm::CheckDigits::M10_001', 'klubkarstadt' => 'Algorithm::CheckDigits::M10_001', 'mastercard' => 'Algorithm::CheckDigits::M10_001', 'miles&more' => 'Algorithm::CheckDigits::M10_001', 'visa' => 'Algorithm::CheckDigits::M10_001', 'isin' => 'Algorithm::CheckDigits::M10_001', 'imei' => 'Algorithm::CheckDigits::M10_001', 'imeisv' => 'Algorithm::CheckDigits::M10_001', 'm10-002' => 'Algorithm::CheckDigits::M10_002', 'siren' => 'Algorithm::CheckDigits::M10_002', 'siret' => 'Algorithm::CheckDigits::M10_002', 'm10-003' => 'Algorithm::CheckDigits::M10_003', 'ismn' => 'Algorithm::CheckDigits::M10_003', 'm10-004' => 'Algorithm::CheckDigits::M10_004', 'ean' => 'Algorithm::CheckDigits::M10_004', 'iln' => 'Algorithm::CheckDigits::M10_004', 'nve' => 'Algorithm::CheckDigits::M10_004', '2aus5' => 'Algorithm::CheckDigits::M10_004', 'isbn13' => 'Algorithm::CheckDigits::M10_004', 'm10-005' => 'Algorithm::CheckDigits::M10_005', 'identcode_dp' => 'Algorithm::CheckDigits::M10_005', 'leitcode_dp' => 'Algorithm::CheckDigits::M10_005', 'm10-006' => 'Algorithm::CheckDigits::M10_006', 'rentenversicherung' => 'Algorithm::CheckDigits::M10_006', 'm10-008' => 'Algorithm::CheckDigits::M10_008', 'sedol' => 'Algorithm::CheckDigits::M10_008', 'm10-009' => 'Algorithm::CheckDigits::M10_009', 'betriebsnummer' => 'Algorithm::CheckDigits::M10_009', 'm10-010' => 'Algorithm::CheckDigits::M10_010', 'postcheckkonti' => 'Algorithm::CheckDigits::M10_010', 'm10-011' => 'Algorithm::CheckDigits::M10_011', 'ups' => 'Algorithm::CheckDigits::M10_011', 'm11-001' => 'Algorithm::CheckDigits::M11_001', 'isbn' => 'Algorithm::CheckDigits::M11_001', 'issn' => 'Algorithm::CheckDigits::M11_001', 'ustid_pt' => 'Algorithm::CheckDigits::M11_001', 'vatrn_pt' => 'Algorithm::CheckDigits::M11_001', 'hkid' => 'Algorithm::CheckDigits::M11_001', 'wagonnr_br' => 'Algorithm::CheckDigits::M11_001', 'nhs_gb' => 'Algorithm::CheckDigits::M11_001', 'vat_sl' => 'Algorithm::CheckDigits::M11_001', 'm11-002' => 'Algorithm::CheckDigits::M11_002', 'pzn' => 'Algorithm::CheckDigits::M11_002', 'm11-003' => 'Algorithm::CheckDigits::M11_003', 'pkz' => 'Algorithm::CheckDigits::M11_003', 'm11-004' => 'Algorithm::CheckDigits::M11_004', 'cpf' => 'Algorithm::CheckDigits::M11_004', 'titulo_eleitor' => 'Algorithm::CheckDigits::M11_004', 'm11-006' => 'Algorithm::CheckDigits::M11_006', 'ccc_es' => 'Algorithm::CheckDigits::M11_006', 'm11-007' => 'Algorithm::CheckDigits::M11_007', 'ustid_fi' => 'Algorithm::CheckDigits::M11_007', 'vatrn_fi' => 'Algorithm::CheckDigits::M11_007', 'm11-008' => 'Algorithm::CheckDigits::M11_008', 'ustid_dk' => 'Algorithm::CheckDigits::M11_008', 'vatrn_dk' => 'Algorithm::CheckDigits::M11_008', 'm11-009' => 'Algorithm::CheckDigits::M11_009', 'nric_sg' => 'Algorithm::CheckDigits::M11_009', 'm11-010' => 'Algorithm::CheckDigits::M11_010', 'ahv_ch' => 'Algorithm::CheckDigits::M11_010', 'm11-011' => 'Algorithm::CheckDigits::M11_011', 'ustid_nl' => 'Algorithm::CheckDigits::M11_011', 'vatrn_nl' => 'Algorithm::CheckDigits::M11_011', 'm11-012' => 'Algorithm::CheckDigits::M11_012', 'bwpk_de' => 'Algorithm::CheckDigits::M11_012', 'm11-013' => 'Algorithm::CheckDigits::M11_013', 'ustid_gr' => 'Algorithm::CheckDigits::M11_013', 'vatrn_gr' => 'Algorithm::CheckDigits::M11_013', 'm11-015' => 'Algorithm::CheckDigits::M11_015', 'esr5_ch' => 'Algorithm::CheckDigits::M11_015', 'm11-016' => 'Algorithm::CheckDigits::M11_016', 'ustid_pl' => 'Algorithm::CheckDigits::M11_016', 'vatrn_pl' => 'Algorithm::CheckDigits::M11_016', 'm11-017' => 'Algorithm::CheckDigits::M11_017', 'ecno' => 'Algorithm::CheckDigits::M11_017', 'ec-no' => 'Algorithm::CheckDigits::M11_017', 'einecs' => 'Algorithm::CheckDigits::M11_017', 'elincs' => 'Algorithm::CheckDigits::M11_017', 'm16-001' => 'Algorithm::CheckDigits::M16_001', 'isan' => 'Algorithm::CheckDigits::M16_001', 'm23-001' => 'Algorithm::CheckDigits::M23_001', 'dni_es' => 'Algorithm::CheckDigits::M23_001', 'm23-002' => 'Algorithm::CheckDigits::M23_002', 'ustid_ie' => 'Algorithm::CheckDigits::M23_002', 'vatrn_ie' => 'Algorithm::CheckDigits::M23_002', 'm43-001' => 'Algorithm::CheckDigits::M43_001', 'code_39' => 'Algorithm::CheckDigits::M43_001', 'm89-001' => 'Algorithm::CheckDigits::M89_001', 'ustid_lu' => 'Algorithm::CheckDigits::M89_001', 'vatrn_lu' => 'Algorithm::CheckDigits::M89_001', 'm97-001' => 'Algorithm::CheckDigits::M97_001', 'ustid_be' => 'Algorithm::CheckDigits::M97_001', 'vatrn_be' => 'Algorithm::CheckDigits::M97_001', 'm97-002' => 'Algorithm::CheckDigits::M97_002', 'iban' => 'Algorithm::CheckDigits::M97_002', 'mxx-001' => 'Algorithm::CheckDigits::MXX_001', 'pa_de' => 'Algorithm::CheckDigits::MXX_001', 'mxx-002' => 'Algorithm::CheckDigits::MXX_002', 'cas' => 'Algorithm::CheckDigits::MXX_002', 'mxx-003' => 'Algorithm::CheckDigits::MXX_003', 'dem' => 'Algorithm::CheckDigits::MXX_003', 'mxx-004' => 'Algorithm::CheckDigits::MXX_004', 'ustid_at' => 'Algorithm::CheckDigits::MXX_004', 'vatrn_at' => 'Algorithm::CheckDigits::MXX_004', 'mxx-005' => 'Algorithm::CheckDigits::MXX_005', 'esr9_ch' => 'Algorithm::CheckDigits::MXX_005', 'verhoeff' => 'Algorithm::CheckDigits::MXX_006', ); sub CheckDigits { my $method = shift || ''; if ( my $pkg = $methods{ lc($method) } ) { my $file = $pkg; $file =~ s{::}{/}g; require "$file.pm"; return new $pkg($method); } else { die "Don't know checkdigit algorithm for '$method'!"; } } # CheckDigits() sub method_list { my @methods = (); foreach my $method ( sort keys %methods ) { push @methods, $method; } return wantarray ? @methods : \@methods; } # method_list() sub print_methods { foreach my $method ( sort keys %methods ) { print "$method => $methods{$method}\n"; } } # print_methods() sub AUTOLOAD { my $self = shift; my $attr = $AUTOLOAD; unless ( $attr =~ /^Algorithm::CheckDigits::[A-Za-z_0-9]*$/ ) { croak "$attr is not defined"; } return ''; } # AUTOLOAD() sub DESTROY { } # Preloaded methods go here. 1; __END__ =head1 NAME Algorithm::CheckDigits - Perl extension to generate and test check digits =head1 SYNOPSIS perl -MAlgorithm::CheckDigits -e Algorithm::CheckDigits::print_methods or use Algorithm::CheckDigits; @ml = Algorithm::CheckDigits->method_list(); $isbn = CheckDigits('ISBN'); if ($isbn->is_valid('3-930673-48-7')) { # do something } $cn = $isbn->complete('3-930673-48'); # $cn = '3-930673-48-7' $cd = $isbn->checkdigit('3-930673-48-7'); # $cd = '7' $bn = $isbn->basenumber('3-930673-48-7'); # $bn = '3-930673-48' =head1 ABSTRACT This module provides a number of methods to test and generate check digits. For more information have a look at the web site F (german). =head1 SUBROUTINES/METHODS =head2 CheckDigits($method) Returns an object of an appropriate Algorithm::CheckDigits class for the given algorithm. Dies with an error message if called with an unknown algorithm. See below for the available algorithms. Every object understands the following methods: =over 4 =item is_valid($number) Returns true or false if C<$number> contains/contains no valid check digit. =item complete($number) Returns a string representation of C<$number> completed with the appropriate check digit. =item checkdigit($number) Extracts the check digit from C<$number> if C<$number> contains a valid check digit. =item basenumber($number) Extracts the basenumber from C<$number> if C<$number> contains a valid check digit. =back =head2 Algorithm::CheckDigits::method_list() Returns a list of known methods for check digit computation. =head2 Algorithm::CheckDigits::print_methods() Returns a list of known methods for check digit computation. You may use the following to find out which methods your version of Algorithm::CheckDigits provides and where to look for further information. perl -MAlgorithm::CheckDigits -e Algorithm::CheckDigits::print_methods =head2 CHECK SUM METHODS At the moment these methods to compute check digits are provided: (vatrn - VAT Return Number, in german ustid UmsatzSTeuer-ID) =over 4 =item m07-001 See L. =item euronote, m09-001 European bank notes, see L. =item amex, bahncard, diners, discover, enroute, eurocard, happydigits, isin, jcb, klubkarstadt, mastercard, miles&more, visa, m09-001, imei, imeisv See L. =item siren, siret, m10-002 See L. =item ismn, m10-003 See L. =item ean, iln, isbn13, nve, 2aus5, m10-004 See L. =item identcode_dp, leitcode_dp, m10-005 See L. =item rentenversicherung, m10-006 See L. =item sedol, m10-008 See L. =item betriebsnummer, m10-009 See L. =item postscheckkonti, m10-010 See L. =item ups, m10-011 See L. =item hkid, isbn, issn, nhs_gb, ustid_pt, vat_sl, wagonnr_br, m11-001 See L. =item pzn, m11-002 See L. =item pkz, m11-003 See L. =item cpf, titulo_eleitor, m11-004 See L. =item ccc_es, m11-006 See L. =item ustid_fi, vatrn_fi, m11-007 See L. =item ustid_dk, vatrn_dk, m11-008 See L. =item nric_sg, m11-009 See L. =item ahv_ch, m11-010 See L. =item ustid_nl, vatrn_nl, m11-011 See L. =item bwpk_de, m11-012 See L. =item ustid_gr, vatrn_gr, m11-013 See L. =item esr5_ch, m11-015 See L. =item ustid_pl, vatrn_pl, m11-016 See L. =item ecno, ec-no, einecs, elincs, m11-017 See L. =item isan, m16-001 See L. =item dni_es, m23-001 See L. =item ustid_ie, vatrn_ie, m23-002 See L. =item code_39, m43-001 See L. =item ustid_lu, vatrn_lu, m89-001 See L. =item ustid_be, vatrn_be, m97-001 See L. =item iban, m97-002 See L. =item upc, mbase-001 See L. =item blutbeutel, bzue_de, ustid_de, vatrn_de, mbase-002 See L. =item sici, mbase-003 See L. =item pa_de, mxx-001 See L. =item cas, mxx-002 See L. =item dem, mxx-003 Old german bank notes (DEM), see L. =item ustid_at, vatrn_at, mxx-004 See L. =item esr9_ch, mxx-005 See L. =item verhoeff, mxx-006 Verhoeff scheme, see L or L =back =head2 EXPORT None by default. =head1 SEE ALSO L, F. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 THANKS Petri Oksanen made me aware that CheckDigits('IMEI') would invoke no test at all since there was no entry for this in the methods hash. =head1 COPYRIGHT AND LICENSE Copyright 2004-2006 by Mathias Weidner This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Algorithm-CheckDigits-0.50/Changes0000644000175000017500000001352711022311761016676 0ustar mathiasmathiasRevision history for Perl extension CheckDigits. 0.50 Fr 6. Jun 21:45:04 CEST 2008 - put $VERSION back into CheckDigits.pm 0.49 Fr 16. Mai 22:54:43 CEST 2008 - CheckDigits/MXX_002.pm computes checkdigits for CAS registration numbers with ten digits. 0.48 Di 9. Okt 01:07:02 CEST 2007 - keep VERSION in Makefile.PL 0.47 Di 9. Okt 00:45:07 CEST 2007 - provide Version in file VERSION - Makefile.PL: indicate minimum perl version (thanks to Slaven Rezic) 0.46 Mo 8. Okt 23:46:32 CEST 2007 - CheckDigits/M11_017.pm computes EC-No (EINECS, ELINCS) check digits. 0.45 So 7. Okt 12:00:25 CEST 2007 - CheckDigits.pm: CheckDigits() dies on unknown algorithm/method - CheckDigits.pm: IMEI and IMEISV are recognized (M10_001.pm) (Petri Oksanen made me aware that this wasn't so before) - CheckDigits/M10_001.pm recognizes that with IMEISV only the 14 most significant digits are taken for the computation of the checkdigit - reformatted CheckDigits.pm, CheckDigits/M10_001.pm 0.44 Mo Dez 11 00:46:30 CET 2006 - Method 97-002 (IBAN): allow min. 2, max. 30 digits/letters for BBAN 0.43 So Dez 10 23:35:31 CET 2006 - Method 97-002 (IBAN): allowed for more letters than just the country code and eliminated Math::BigInt (Thanks to Detlef Pilzecker). 0.42 Fr Dez 1 22:02:57 CET 2006 - Method 10-004: added code to handle ISBN-13 (mainly check whether first three digits are 978 or 979 and cope with hyphens) - CheckDigits.pm: Invocation as CheckDigits('isbn13') returns an Algorithm::CheckDigits::M10_004 object. - added tests for isbn13 0.41 Do Jun 29 00:34:04 CEST 2006 - added t/pod-coverage.t - added missing documentation 0.40 Mi Jun 28 23:31:00 CEST 2006 - fixed code examples in POD according to http://annocpan.org/~MAMAWE/Algorithm-CheckDigits-0.39/CheckDigits/MXX_002.pm - CheckDigits.pm: POD: corrected ABSTRACT - added t/pod.t to check for POD errors - fixed POD according to t/pod.t - Clarified POD for Algorithm/CheckDigits/MXX_006.pm 0.39 Sun, 12 Mar 2006 17:50:13 +0100 - Added Verhoeff scheme (Method XX-006) taking some code from Algorithm::Verhoeff. - Refined POD for CheckDigits.pm 0.38 Wed, 26 Jan 2005 22:48:10 +0100 - Refined Method M11-011 (now accepts full vatrn) - provided basic tests for above change 0.37 Wed, 14 Jul 2004 20:38:31 +0200 - Method 10-001: Added Support for ISIN - Method XX-004 (ustid_at) implemented - Method XX-005 (esr9_ch) implemented 0.36 Tue, 13 Jul 2004 23:45:02 +0200 - Method XX-003 (dem) implemented - Method XX-002 (cas) implemented 0.35 Sun, 11 Jul 2004 18:59:35 +0200 - Method XX-001 (pa_de) implemented 0.34a Fri, 09 Jul 2004 23:57:37 +0200 - Method 97-002 (iban) implemented 0.34 Wed, 14 Jun 2004 22:04:38 +0200 - Method 97-001 (ustid_be) implemented 0.33 Wed, 09 Jun 2004 22:04:38 +0200 - Method 23-002 (ustid_ie) implemented - Method 43-001 (code_39) implemented - Method 89-001 (ustid_lu) implemented 0.32 Fri, 14 May 2004 17:22:15 +0200 - Aaron W. West made me aware of a fault in MBase_001.pm (the code providing UPC check digits) and sent me a fix - added test routine for that failure 0.31 Tue, 11 May 2004 00:26:56 +0200 - Method 23-001 (dni_es) implemented - Renamed methods 001..010 0.30 Mon, 10 May 2004 01:00:14 +0200 - Method 16-001 (isan) implemented - Renamed methods 011, 012, 013, 014, 015 0.29 Wed, 05 May 2004 23:00:26 +0200 - Method 11-013 (vatrn_gr), 11-015 (esr5_ch) implemented - Renamed methods 016,017,018,019 - Changed man pages (synopsis) for some methods 0.27 Wed, 28 Apr 2004 23:22:41 +0200 - Method 11-012 implemented - Man page in CheckDigits.pm changed - Packages changed from CheckDigits... to Algorithm::CheckDigits... 0.26 Sun, 25 Apr 2004 22:43:39 +0200 - Method 11-011 implemented - Man page in CheckDigits.pm changed 0.25 Mon, 19 Apr 2004 22:54:56 +0200 - Method 11-016 implemented - Method 11-010 implemented 0.23 Sun, 18 Apr 2004 23:09:58 +0200 - Method 11-009 implemented 0.22 Sat, 17 Apr 2004 21:35:35 +0200 - Method 11-008 implemented 0.21 Thu, 15 Apr 2004 23:09:40 +0200 - Method 11-007 implemented - documented algorithm from Method M019 in the man page 0.20 Mon, 12 Apr 2004 23:28:05 +0200 - added tests with invalid data - Method Base-003 implemented 0.19 Thu, 26 Feb 2004 00:27:47 +0100 - took all test cases from www.pruefziffernberechnung.de into t/valid.data and inserted plan(... todo => ...) into t/valid.t - Method 019 implemented (algorithm not documented in man page!) 0.18 Thu, 25 Dec 2003 18:17:56 +0100 - Method 018 implemented 0.17 Fri, 28 Nov 2003 21:00:18 +0100 - Method 017 implemented - all tests for valid checkdigits into one testscript (valid.t) using one datafile (valid.data) 0.16 Die Nov 11 23:15:27 CET 2003 - Method 016 implemented - Typo in POD of M013.pm corrected 0.15 Mon Nov 10 23:23:10 CET 2003 - Method 015 implemented - Typo in POD of M014.pm corrected 0.14 Fre Okt 24 23:53:28 CEST 2003 - Method 014 implemented 0.13 Son Okt 19 23:25:09 CEST 2003 - Method 013 implemented 0.12 Die Okt 7 22:43:36 CEST 2003 - Method 012 implemented 0.11 Mon Okt 6 22:21:12 CEST 2003 - Method 011 implemented - Typo in POD of M010.pm corrected 0.10 Sam Sep 27 14:03:11 CEST 2003 - Method 010 implemented 0.09 Fre Sep 26 18:49:22 CEST 2003 - Method 009 implemented 0.08 Don Sep 25 21:41:26 CEST 2003 - Method 008 implemented 0.07 Mit Sep 24 22:06:44 CEST 2003 - Method 006, 007 implemented 0.05 Son Sep 21 15:17:46 CEST 2003 - Method 004, 005 implemented inclusive test routines and data - cleaned up code and doc for all methods so far 0.04 Sam Sep 20 23:54:09 CEST 2003 - Method 002, 003 implemented inclusive test routines and data 0.03 Fre Sep 19 23:15:04 CEST 2003 - Method 001 implemented inclusive test routines and data 0.01 Tue Sep 16 23:03:45 2003 - original version; created by h2xs 1.21 with options -A -X CheckDigits Algorithm-CheckDigits-0.50/CheckDigits/0000755000175000017500000000000011022312327017553 5ustar mathiasmathiasAlgorithm-CheckDigits-0.50/CheckDigits/MXX_005.pm0000644000175000017500000000643711013473143021167 0ustar mathiasmathiaspackage Algorithm::CheckDigits::MXX_005; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my $ctable = [ [ 0, 9, 4, 6, 8, 2, 7, 1, 3, 5, 0, ], [ 9, 4, 6, 8, 2, 7, 1, 3, 5, 0, 9, ], [ 4, 6, 8, 2, 7, 1, 3, 5, 0, 9, 8, ], [ 6, 8, 2, 7, 1, 3, 5, 0, 9, 4, 7, ], [ 8, 2, 7, 1, 3, 5, 0, 9, 4, 6, 6, ], [ 2, 7, 1, 3, 5, 0, 9, 4, 6, 8, 5, ], [ 7, 1, 3, 5, 0, 9, 4, 6, 8, 2, 4, ], [ 1, 3, 5, 0, 9, 4, 6, 8, 2, 7, 3, ], [ 3, 5, 0, 9, 4, 6, 8, 2, 7, 1, 2, ], [ 5, 0, 9, 4, 6, 8, 2, 7, 1, 3, 1, ], ]; sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{8})(\d)$/i) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{8})$/i) { return $number . $self->_compute_checkdigit($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{8})(\d)$/i) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{8})(\d)$/i) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; my $carry = 0; if ($number =~ /^\d{8}$/) { my @digits = split(//,$number); for (my $i = 0;$i <= $#digits;$i++) { $carry = $ctable->[$carry]->[$digits[$i]]; } return (10 - $carry) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MXX_005 - compute check digits for ESR9 (CH) =head1 SYNOPSIS use Algorithm::CheckDigits; $esr = CheckDigits('esr9'); if ($esr->is_valid('123456786')) { # do something } $cn = $esr->complete('12345678'); # $cn = '123456786' $cd = $esr->checkdigit('123456786'); # $cd = '6' $bn = $esr->basenumber('123456786'); # $bn = '12345678' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Digits are processed left to right. For the first digit applies the balance is 0. =item 2 The new balance is taken from the balance table according to the current balance (row) and the digit (column). =item 3 The check digit is the difference from the last balance to 10 taken modulo 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_005.pm0000644000175000017500000000605011013473143021037 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_005; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([0-9 .]{11,})([0-9])$/) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[0-9 .]{11,}$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([0-9 .]{11,})([0-9])$/) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([0-9 .]{11,})([0-9])$/) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/[.\s]//g; if ($number =~ /^([0-9]{11})$/) { my @digits = split(//,$number); my $even = 0; my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { if ($even) { $sum += 9 * $digits[$i]; } else { $sum += 4 * $digits[$i]; } $even = not $even; } return (10 - $sum % 10) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_005 - compute check digits for Deutsche Post Identcode/Leitcode (DE) =head1 SYNOPSIS use Algorithm::CheckDigits; $ic = CheckDigits('identcode_dp'); if ($ic->is_valid('21.802 580.906 6')) { # do something } $cn = $ic->complete('21.802 580.906'); # $cn = '21.802 580.9066' $cd = $ic->checkdigit('21.802 580.906 6'); # $cd = '6' $bn = $ic->basenumber('21.802 580.906 6'); # $bn = '21.802 580.906' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left all numbers are weighted alternatively 4 and 9. =item 2 The sum of all products is computed. =item 3 The sum of step 3 ist taken modulo 10. =item 4 The check digit is the difference between 10 and the number from step 3. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/MBase_002.pm0000644000175000017500000000603511013473143021471 0ustar mathiasmathiaspackage Algorithm::CheckDigits::MBase_002; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return uc($2) eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[ 0-9]+$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return $1 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^[ 0-9]+$/) { $number =~ s/ //g; my @digits = split(//,$number); my $sum = 0; my $prod = 10; for (my $i = 0; $i <= $#digits; $i++) { $sum = (($prod + $digits[$i]) % 10) || 10; $prod = (2 * $sum) % 11; } return (11 - $prod) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MBase_002 - compute check digits for blood bags (DE), BZÜ (DE), VAT Registration Number (DE) =head1 SYNOPSIS use Algorithm::CheckDigits; $bb = CheckDigits('blutbeutel'); if ($bb->is_valid('2761011234567893')) { # do something } $cn = $bb->complete('276101123456789'); # $cn = '2761011234567893' $cd = $bb->checkdigit('2761011234567893'); # $cd = '3' $bn = $bb->basenumber('2761011234567893'); # $bn = '276101123456789'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Start with values P = 10, S = 0. =item 2 Beginning left you do the following for all digits =over 4 =item 1 S = (P + digit) modulo 10 =item 2 If S is 0 then S = 10. =item 3 P = (2 * S) modulo 11 =back =item 3 The check digit is (11 - P) modulo 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M97_001.pm0000644000175000017500000000521211013473143021051 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M97_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{7})?(\d\d)$/i) { return $2 eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{7})$/i) { return $number . $self->_compute_checkdigit($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{7})(\d\d)$/i) { return $1 if ($2 eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{7})(\d\d)$/i) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^\d{7}$/i) { return sprintf("%2.2d",97 - ($number % 97)); } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M97_001 - compute check digits for VAT Registration Number (BE) =head1 SYNOPSIS use Algorithm::CheckDigits; $ustid = CheckDigits('ustid_be'); if ($ustid->is_valid('136695962')) { # do something } $cn = $ustid->complete('1366959'); # $cn = '136695962' $cd = $ustid->checkdigit('136695962'); # $cd = '62' $bn = $ustid->basenumber('136695962'); # $bn = '1366959' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 The whole number (without checksum) is taken modulo 97. =item 2 The checksum is difference of the remainder from step 1 to 97. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigits of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/MBase_003.pm0000644000175000017500000001046711013473143021476 0ustar mathiasmathiaspackage Algorithm::CheckDigits::MBase_003; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 6, 3, 7, 9, 10, 5, 8, 4, 2, 1 ); my %table_to = ( '0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4, '5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9, 'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14, 'F' => 15, 'G' => 16, 'H' => 17, 'I' => 18, 'J' => 19, 'K' => 20, 'L' => 21, 'M' => 22, 'N' => 23, 'O' => 24, 'P' => 25, 'Q' => 26, 'R' => 27, 'S' => 28, 'T' => 29, 'U' => 30, 'V' => 31, 'W' => 32, 'X' => 33, 'Y' => 34, 'Z' => 35, ); my @table_from = ( '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '#', ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/) { return uc($2) eq $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(.*)$/) { return "$1" . $self->_compute_checkdigits($1) } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/) { return "$1" if ($2 eq $self->_compute_checkdigits($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/) { return $2 if ($2 eq $self->_compute_checkdigits($1)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my $number = shift; my $digit; my @digits = split(//,$number); my $even = 0; my $sum1 = 0; my $sum2 = 0; for (my $i = $#digits; $i>= 0; $i--) { if (uc($digits[$i]) =~ /[0-9A-Z]/) { $digit = $table_to{uc($digits[$i])}; } else { $digit = 36; } $sum1 += 3 * $digit unless ($even); $sum2 += $digit if ($even); $even = not $even; } my $sum = 37 - (($sum1 + $sum2) % 37); return $table_from[$sum]; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MBase_003 - compute check digits for SICI (Serial Item and Contribution Identifier) =head1 SYNOPSIS use Algorithm::CheckDigits; $sici = CheckDigits('sici'); if ($sici->is_valid('0784-8679(20040308)6:<138>2.0.TX;2-H')) { # do something } $cn = $sici->complete('0784-8679(20040308)6:<138>2.0.TX;2-'); # $cn = '0784-8679(20040308)6:<138>2.0.TX;2-H' $cd = $sici->checkdigit('0784-8679(20040308)6:<138>2.0.TX;2-H'); # $cd = 'H' $bn = $sici->basenumber('0784-8679(20040308)6:<138>2.0.TX;2-H'); # $bn = '0784-8679(20040308)6:<138>2.0.TX;2-'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 0 In the string describing the number all letters (A-Z) are replaced with numbers 10-35 accordingly. All other non-numbers are replaced by 36. =item 1 Beginning right the numbers at all odd positions are added. =item 2 The sum from step 1 is multiplied by 3. =item 3 Beginning right the numbers at all even positions are added. =item 4 The sums from step 2 and 3 are added. =item 5 The sum from step 4 is taken modulo 37. =item 6 The checksum is 37 minus the sum from step 5 where numbers from 10 to 35 are represented by 'A' to 'Z' accordingly and 36 is represented by '#'. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, F =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_006.pm0000644000175000017500000000622111013473143021040 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_006; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 2,1,2,5,7,1,2,1,2,1,2,1 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{8}[A-Za-z]\d\d)(\d)$/) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^\d{8}[A-Za-z]\d\d$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{8}[A-Za-z]\d\d)(\d)$/) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{8}[A-Za-z]\d\d)(\d)$/) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^(\d{8})([A-Za-z])(\d\d)$/) { my $lv = sprintf("%2.2d",ord(uc($2)) - ord('A') + 1); my @digits = split(//,"$1$lv$3"); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { my $tmp = $weight[$i] * $digits[$i]; $sum += $tmp / 10; $sum += $tmp % 10 } return $sum % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_006 - compute check digits for Rentenversicherung (DE) =head1 SYNOPSIS use Algorithm::CheckDigits; $rv = CheckDigits('rentenversicherung'); if ($rv->is_valid('65180539W001')) { # do something } $cn = $rv->complete('65180539W00'); # $cn = '65180539W001' $cd = $rv->checkdigit('65180539W001'); # $cd = '1' $bn = $rv->basenumber('65180539W001'); # $bn = '65180539W00' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 The letter is replaced with a two-figure number appropriate to the position of the letter in the german alphabet. =item 2 Beginning left all numbers are weighted with 2,1,2,5,7,1,2,1,2,1,2,1. =item 3 The the total of the digits of all products is computed. =item 4 The check digit is sum from step 3 taken modulo 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_012.pm0000644000175000017500000000741611013473143021045 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_012; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 2,3,4,5,6,7,1,6,7,2,3 ); my %table_to = ( 0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8, 9 => 9, A => 12, B => 14, C => 16, D => 18, E => 20, F => 22, G => 24, H => 26, I => 28, J => 6, K => 8, L => 10, M => 12, N => 14, O => 16, P => 18, Q => 20, R => 22, S => 4, T => 6, U => 8, V => 10, W => 12, X => 14, Y => 16, Z => 18, ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([-0-9a-z]+)(\d)$/i) { return $2 == $self->_compute_checkdigits($1); } return undef; } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^([-0-9a-z]+)$/i and (my $cd = $self->_compute_checkdigits($1)) ne '') { return $1 . $cd; } return undef; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([-0-9a-z]+)(\d)$/i) { return $1 if ($2 == $self->_compute_checkdigits($1)); } return undef; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([-0-9a-z]+)(\d)$/i) { return $2 if ($2 == $self->_compute_checkdigits($1)); } return undef; } # checkdigit() sub _compute_checkdigits { my $self = shift; my $number = shift; $number =~ s/-//g; my @digits = split(//,$number); my $len = scalar(@digits) + 1; my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $table_to{uc($digits[$i])}; } $sum %= 11; return ($sum == 0) ? 1 : ($sum == 1) ? 0 : 11 - $sum; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_012 - compute check digits for Bundeswehrpersonenkennnummer (DE) =head1 SYNOPSIS use Algorithm::CheckDigits; $bwpk = CheckDigits('bwpk_de'); if ($bwpk->is_valid('151058-D-20711')) { # do something } $cn = $bwpk->complete('151058-D-2071'); # $cn = '151058-D-20711' $cd = $bwpk->checkdigit('151058-D-20711'); # $cd = '1' $bn = $bwpk->basenumber('151058-D-20711'); # $bn = '151058-D-2071'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left all digits are weighted 2,3,4,5,6,7,1,6,7,2,3. Letters are replaced according to the following table: my %table_to = ( A => 12, B => 14, C => 16, D => 18, E => 20, F => 22, G => 24, H => 26, I => 28, J => 6, K => 8, L => 10, M => 12, N => 14, O => 16, P => 18, Q => 20, R => 22, S => 4, T => 6, U => 8, V => 10, W => 12, X => 14, Y => 16, Z => 18, ); =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 The checksum is 11 minus the sum from step 3. If the difference is 10, the checkdigit is 0. If the difference is 11, the checkdigit is 1. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_010.pm0000644000175000017500000000616011013473143021035 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_010; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @items = ( 0,9,4,6,8,2,7,1,3,5 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d\d-?\d{8})-?(\d)$/) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^\d\d-?\d{8}-?$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d\d-?\d{8}-?)(\d)$/) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d\d-?\d{8})-?(\d)$/) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^\d\d-?\d{8}-?$/) { $number =~ s/-//g; my @digits = split(//,$number); my $sum = 0; my $cf = 0; for (my $i = 0; $i <= $#digits; $i++) { $cf = $items[($digits[$i] + $cf) % 10]; } return (10 - $cf) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_010 - compute check digits for Postscheckkonti (CH) =head1 SYNOPSIS use Algorithm::CheckDigits; $pck = CheckDigits('postcheckkonti'); if ($pck->is_valid('85-12345678-7')) { # do something } $cn = $pck->complete('85-12345678'); # $cn = '85-12345678-7' $cd = $pck->checkdigit('85-12345678-7'); # $cd = '7' $bn = $pck->basenumber('85-12345678-7'); # $bn = '85-12345678' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 The sequence of digits is processed left to right. For the first digit we assume a carry forward of 0. =item 2 For each digit d(i) the carry forward cf(i) is the digit at the the position p in the sequence ( 0, 9, 4, 6, 8, 2, 7, 1, 3, 5 ), where p is (d(i) + cf(i-1)) modulo 10. =item 3 The check digit is the difference of the sum from step 3 to the next multiple of 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_015.pm0000644000175000017500000000570011013473143021042 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_015; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 2, 3, 4, 5, 6, 7 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/) { return $2 == $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d+)$/) { return "$1" . $self->_compute_checkdigits($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/) { return $1 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/) { return $2 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my @digits = split(//,shift); my $sum = 0; for (my $i = $#digits; $i >= 0; $i--) { $sum += $weight[($#digits - $i) % 6] * $digits[$i]; } $sum %= 11; my $retval = (0 == $sum) ? '00' : (11 - $sum); $retval; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_015 - compute check digits for ESR5 (CH) =head1 SYNOPSIS use Algorithm::CheckDigits; $ustid = CheckDigits('esr5_ch'); if ($ustid->is_valid('123456786')) { # do something } $cn = $ustid->complete('12345678'); # $cn = '123456786' $cd = $ustid->checkdigit('123456786'); # $cd = '6' $bn = $ustid->basenumber('123456786'); # $bn = '12345678'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left every digit is weighted with 7,9,10,5,8,4,2. =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 The checkdigit is 11 minus the sum from step 3. Is the difference 10, the number won't be taken. If the difference is 11, the checkdigit is 0. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/M07_001.pm0000644000175000017500000000516011013473143021042 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M07_001; use 5.006; use strict; use warnings; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $class = ref($proto) || $proto; return bless({}, $class); } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([0-9]*)([0-9])$/) { return ($2 == _compute_checkdigit($1)); } return 0; } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^([0-9]*)$/) { return $number . _compute_checkdigit($1); } return undef; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([0-9]*)([0-9])$/) { return $1 if ($2 == _compute_checkdigit($1)); } return undef; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([0-9]*)([0-9])$/) { return $2 if ($2 == _compute_checkdigit($1)); } return undef; } # checkdigit() sub _compute_checkdigit { my $number = shift; my @digits = split(//,$number); my $even = 0; my $sum = 0; foreach my $digit (@digits) { $sum += $digit; $sum += $digit if ($even); $even = not $even; } return $sum % 7; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M07_001 - compute check digits modulo 7 method 1 =head1 SYNOPSIS use Algorithm::CheckDigits; $m001 = CheckDigits('m001'); if ($m001->is_valid('1234567892')) { # do something } $cn = $m001->complete('123456789'); # $cn = '1234567892' $cd = $m001->checkdigit('1234567892'); # $cd = '2' $bn = $m001->basenumber('1234567892'); # $bn = '123456789' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1. All digits are added. =item 2. All digits at even positions are added. =item 3. The sum of step 1 and 2 is taken modulo 7. =item 4. This is the check digit. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or undef if C<$number> does not consist solely of digits. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return undef otherwise. =item checkdigit($number) Returns the check digit belonging to C<$number> or undef if C<$number> does not consist solely of digits. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_002.pm0000644000175000017500000000621611013473143021040 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_002; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([0-9 ]*)([0-9])$/) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[0-9 ]*$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([0-9 ]*)([0-9])$/) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([0-9 ]*)([0-9])$/) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/\s//g; if ($number =~ /^([0-9]*)$/) { my @digits = split(//,$number); my $even = 1; my $sum = 0; for (my $i = $#digits; $i >= 0; $i--) { if ($even) { my $tmp = 2 * $digits[$i]; $sum += $tmp / 10 + $tmp % 10; } else { $sum += $digits[$i]; } $even = not $even; } return (10 - $sum % 10) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_002 - compute check digits for CINS (US), SIREN (FR), SIRET (FR) =head1 SYNOPSIS use Algorithm::CheckDigits; $siret = CheckDigits('siret'); if ($siret->is_valid('73282932000074')) { # do something } $cn = $siret->complete('7328293200007'); # $cn = '73282932000074' $cd = $siret->checkdigit('73282932000074'); # $cd = '4' $bn = $siret->basenumber('73282932000074'); # $bn = '7328293200007' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning right all numbers are weighted alternatively 1 and 2. =item 2 The total of the digits of all products is computed. =item 3 The sum of step 3 ist taken modulo 10. =item 4 The check digit is the difference between 10 and the number from step 3 taken modulo 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. F =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_008.pm0000644000175000017500000000547711013473143021057 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_008; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 2, 7, 6, 5, 4, 3, 2, 1 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{8})$/) { return 0 == $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; return "$1" if( $number =~ /^(\d{8})$/ and 0 == $self->_compute_checkdigits($1)); return ''; } # complete() sub basenumber { my ($self,$number) = @_; return "$1" if( $number =~ /^(\d{8})$/ and 0 == $self->_compute_checkdigits($1)); return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; return '' if( $number =~ /^(\d{8})$/ and 0 == $self->_compute_checkdigits($1)); return undef; } # checkdigit() sub _compute_checkdigits { my $self = shift; my @digits = split(//,shift); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $digits[$i]; } $sum %= 11; return $sum; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_008 - compute check digits for VAT Registration Number (DK) =head1 SYNOPSIS use Algorithm::CheckDigits; $ustid = CheckDigits('ustid_dk'); if ($ustid->is_valid('13585628')) { # do something } $cn = $ustid->complete('1358562'); # $cn = '13585628' $cd = $ustid->checkdigit('13585628'); # $cd = '8' $bn = $ustid->basenumber('13585628'); # $bn = '1358562'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left every digit is weighted with 2, 7, 6, 5, 4, 3, 2, 1 =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 The number is valid if the sum from step 3 is zero (0). =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns '' if C<$number> is valid. Return undef otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/M23_001.pm0000644000175000017500000000537411013473143021047 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M23_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @keytable = ( 'T', 'R', 'W', 'A', 'G', 'M', 'Y', 'F', 'P', 'D', 'X', 'B', 'N', 'J', 'Z', 'S', 'Q', 'V', 'H', 'L', 'C', 'K', 'E', ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{8})-?([A-HJ-NP-TV-Z])$/i) { return $2 eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{8})-?$/i) { return $number . $self->_compute_checkdigit($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{8}-?)([A-HJ-NP-TV-Z])$/i) { return $1 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{8})-?([A-HJ-NP-TV-Z])$/i) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/-//g; if ($number =~ /^\d{8}$/i) { return $keytable[($number % 23)]; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M23_001 - compute check digits for DNI (ES) =head1 SYNOPSIS use Algorithm::CheckDigits; $dni = CheckDigits('dni_es'); if ($dni->is_valid('54362315K')) { # do something } $cn = $dni->complete('54362315'); # $cn = '54362315K' $cd = $dni->checkdigit('54362315K'); # $cd = 'K' $bn = $dni->basenumber('54362315K'); # $bn = '54362315' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 The checkdigit is the whole number taken modulo 23 and coded according to a keytable. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/MXX_004.pm0000644000175000017500000000605311013473143021160 0ustar mathiasmathiaspackage Algorithm::CheckDigits::MXX_004; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(?:AT)?U?(\d{7})(\d)$/i) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(?:AT)?U?(\d{7})$/i) { return $number . $self->_compute_checkdigit($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(AT)?(U)?(\d{7})(\d)$/i) { my $cc = $1 || ''; my $u = $2 || ''; return $cc.$u.$3 if ($4 == $self->_compute_checkdigit($3)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(?:AT)?U?(\d{7})(\d)$/i) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/\s//g; if ($number =~ /^\d{7}$/) { my @digits = split(//,$number); my $even = 1; my $sum = 0; for (my $i = $#digits;$i >= 0;$i--) { if ($even) { $sum += $digits[$i]; } else { my $tmp = 2 * $digits[$i]; $sum += $tmp / 10 + $tmp % 10; } $even = not $even; } return (96 - $sum) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MXX_004 - compute check digits for VAT RN (AT) =head1 SYNOPSIS use Algorithm::CheckDigits; $vat = CheckDigits('ustid_at'); if ($vat->is_valid('U13585627')) { # do something } $cn = $vat->complete('U1358562'); # $cn = 'U13585627' $cd = $vat->checkdigit('U13585627'); # $cd = '7' $bn = $vat->basenumber('U13585627'); # $bn = 'U1358562' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning right all numbers before the check digit are weighted alternatively 1 and 2. =item 2 The total of the digits of all products is computed and then subtracted from 96. =item 3 The check digit is the sum of step 3 taken modulo 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_001.pm0000644000175000017500000001060411013473143021034 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my $cd = { 'isbn' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 'X', 0 ], 'ustid_pt' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0 ], 'hkid' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 'A', 0 ], 'wagonnr_br' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1 ], 'nhs_gb' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, 0 ], 'vat_sl' => [ 1, 0, 2, 3, 4, 5, 6, 7, 8, 9, 0, -1 ], # ? }; $cd->{'issn'} = $cd->{'isbn'}; sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return uc($2) eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[-0-9A-Za-z]+$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return $1 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^[-0-9A-Za-z]+$/) { $number =~ s/-//g; my @digits = split(//,$number); my $sum = 0; my $weight = 2; for (my $i = $#digits; $i >= 0; $i--) { $digits[$i] = 1 + ord(uc($digits[$i])) - ord('A') if ($digits[$i] =~ /[A-Z]/i); $sum += $weight * $digits[$i]; ++$weight; } $sum %= 11; return $cd->{$self->{type}}[11-$sum] if ($cd->{$self->{type}}); } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_001 - compute check digits for ISBN, ISSN, VAT RN (PT), HKID (HK), Wagon number (BR), NHS (GB), VAT (SL) =head1 SYNOPSIS use Algorithm::CheckDigits; $isbn = CheckDigits('isbn'); if ($isbn->is_valid('3-88229-192-3')) { # do something } $cn = $isbn->complete('3-88229-192-'); # $cn = '3-88229-192-3' $cd = $isbn->checkdigit('3-88229-192-3'); # $cd = '3' $bn = $isbn->basenumber('3-88229-192-3'); # $bn = '3-88229-192-' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 The sequence of digits is processed right to left. Every digit is multiplied with their position in the sequence (i.e. the digit left to the check digit has the weight 2 then 3 etc.). With a Hongkong ID (hkid) the leftmost char is replaced with its position in the alphabet and then multiplied with 8 (its weight). =item 2 The sum of all products is computed. =item 3 The sum of step 2 is taken modulo 11. =item 4 The checkdigit is the difference of the sum from step 3 to eleven under the following conditions: =over 8 =item isbn,issn If the difference is 10, the check digit is 'X'. If the difference is 11, the check digit is 0. =item ustid_pt If the difference is greater then 9, the check digit is '0'. =item hkid If the difference is 10, the check digit is 'A'. If the difference is 11, the check digit is 0. =item wagonnr_br If the difference is 10, the check digit is 0. If the difference is 11, the check digit is 1. =item nhs_gb If the difference is 10, the number would not be taken. If the difference is 11, the check digit is 0. =item vat_sl This is a little bit unclear, don't trust on the method for this type. =back =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_003.pm0000644000175000017500000000661411013473143021044 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_003; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 4,2,1,6,3,7,9,10,5,8,4,2 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{11})(\d)$/) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^\d{11}$/) { my $cd = $self->_compute_checkdigit($number); return 0 > $cd ? '' : $number . $cd; } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{11})(\d)$/) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{11})(\d)$/) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^\d{11}$/) { my @digits = split(//,$number); my $sum = 0; my $cf = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $digits[$i]; } $sum %= 11; for (my $i = 0; $i <= 9; $i++) { return $i if (10 == ($sum + $weight[11] * $i) % 11); } } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_003 - compute check digits for PKZ (GDR) =head1 SYNOPSIS use Algorithm::CheckDigits; $pkz = CheckDigits('pkz'); if ($pkz->is_valid('150765400354')) { # do something } $cn = $pkz->complete('15076540035'); # $cn = '150765400354' $cd = $pkz->checkdigit('150765400354'); # $cd = '4' $bn = $pkz->basenumber('150765400354'); # $bn = '150765400354' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 The checkdigit is set to 0. =item 2 From right to left the digits are weighted (multiplied) with 2,4,8,5,10,9,7,3,6,1,2,4. =item 3 The products are added. =item 4 The sum of step 3 is taken modulo 11. =item 5 The value of step 4 is added to a multiple (0..9) of the weight of the checkdigit (2). =item 6 The sum of step 5 is taken modulo 11. =item 7 The checkdigit is the multiple of the weight of the checkdigit where the value of step 6 equals 10. =item 8 If there can't be reached a value of 10 in step 6, the number cannot be taken as a PKZ. =back To validate a PKZ apply steps 2 to 4 to the complete number. =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_013.pm0000644000175000017500000000606411013473143021044 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_013; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([0-9]+)(\d)$/) { return $2 == $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^([0-9]+)$/ and (my $cd = $self->_compute_checkdigits($1)) ne '') { return $1 . $cd; } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([0-9]+)(\d)$/) { return $1 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([0-9]+)(\d)$/) { return $2 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my $number = shift; $number =~ s/\.//g; my @digits = split(//,$number); my $len = scalar(@digits); my $sum = 0; for (my $i = $#digits; $i >= 0; $i--) { $sum += 2 ** ($len - $i) * $digits[$i]; } $sum %= 11; return ($sum > 9) ? 0 : $sum; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_013 - compute check digits for VAT Registration Number (GR) =head1 SYNOPSIS use Algorithm::CheckDigits; $ustid = CheckDigits('ustid_gr'); if ($ustid->is_valid('123456783')) { # do something } $cn = $ustid->complete('12345678'); # $cn = '123456783' $cd = $ustid->checkdigit('123456783'); # $cd = '3' $bn = $ustid->basenumber('123456783'); # $bn = '12345678'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning right with the digit before the checkdigit all digits are weighted with 2 ** position. I. e. the last digit is multiplied with 2, the next with 4, then 8 and so on. =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 If the sum from step 3 is greater than 9, the check sum is 0 else it is the sum itself. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_009.pm0000644000175000017500000000602011013473143021041 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_009; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 2, 7, 6, 5, 4, 3, 2 ); my @keys = ('', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'Z', 'J' ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([fgst])(\d{7})([a-jz])$/i) { return (uc($3) eq $self->_compute_checkdigits($2)); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if($number =~ /^([fgst])(\d{7})$/i) { return $1 . $2 . $self->_compute_checkdigits($2); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; return "$1$2" if( $number =~ /^([fgst])(\d{7})([a-jz])$/i and uc($3) eq $self->_compute_checkdigits($2)); return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([fgst])(\d{7})([a-jz])$/i) { return $self->_compute_checkdigits($2); } return undef; } # checkdigit() sub _compute_checkdigits { my $self = shift; my @digits = split(//,shift); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $digits[$i]; } $sum %= 11; return $keys[11 - $sum]; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_009 - compute check digits NRIC (SG) =head1 SYNOPSIS use Algorithm::CheckDigits; $nric = CheckDigits('nric_sg'); if ($nric->is_valid('S1234567D')) { # do something } $cn = $nric->complete('S1234567'); # $cn = 'S1234567D' $cd = $nric->checkdigit('S1234567D'); # $cd = 'D' $bn = $nric->basenumber('S1234567D'); # $bn = 'S1234567'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left every digit is weighted with 2, 7, 6, 5, 4, 3, 2 =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 The checkdigit is 11 minus the sum from step 3 converted to a character according to the following table: @cd = ('','A','B','C','D','E','F','G','H','I','Z','J', ); =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns '' if C<$number> is valid. Return undef otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/MXX_002.pm0000644000175000017500000000650511013473143021160 0ustar mathiasmathias# vim: set ts=4 sw=4 tw=78 et si: package Algorithm::CheckDigits::MXX_002; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless( {}, $class ); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ( $self, $number ) = @_; if ( $number =~ /^(\d{1,7}-?\d{2}-?)(\d)$/ ) { return 1 if ( $2 == $self->_compute_checkdigit($1) ); } return ''; } # is_valid() sub complete { my ( $self, $number ) = @_; if ( $number =~ /^\d{1,7}-?\d{2}-?$/ ) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ( $self, $number ) = @_; if ( $number =~ /^(\d{1,7}-?\d{2}-?)(\d)$/ ) { return $1 if ( $2 == $self->_compute_checkdigit($1) ); } return ''; } # basenumber() sub checkdigit { my ( $self, $number ) = @_; if ( $number =~ /^(\d{1,7}-?\d{2}-?)(\d)$/ ) { return $2 if ( $2 == $self->_compute_checkdigit($1) ); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/-//g; my @digits = split( //, $number ); my $weight = 1; my $sum = 0; for ( my $i = $#digits; $i >= 0; $i-- ) { $sum += $digits[$i] * $weight++; } return $sum % 10; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MXX_002 - compute check digits for CAS =head1 SYNOPSIS use Algorithm::CheckDigits; $cas = CheckDigits('cas'); if ($cas->is_valid('1333-74-0')) { # do something } $cn = $cas->complete('1333-74-'); # $cn = '1333-74-0' $cd = $cas->checkdigit('1333-74-0'); # $cd = '0' $bn = $cas->basenumber('1333-74-0'); # $bn = '1333-74-' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning right with the second digit all digits are weighted ascending starting with 1. =item 2 The sum of those products is computed. =item 3 The checksum is the last digit of the sum from step 2 (modulo 10). =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 THANKS Aaron W. West pointed me to a fault in the computing of the check digit. HERMIER Christophe made me aware that CAS is now assigning 10-digit CAS Registry Numbers (F) =head1 SEE ALSO L, L, F, F F =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_001.pm0000644000175000017500000001232711013473143021037 0ustar mathiasmathias# vim: set ts=4 sw=4 tw=78 si et: package Algorithm::CheckDigits::M10_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my %prefix = ( 'amex' => [ '34', '37', ], 'bahncard' => [ '70', ], 'diners' => [ '30[0-5]', '36', '38', ], 'discover' => [ '6011', ], 'enroute' => [ '2014', '2149', ], 'jcb' => [ '1800', '2131', '3088', ], 'mastercard' => [ '5[1-5]', ], 'miles&more' => [ '99', '22', ], 'visa' => [ '4', ], ); my %ctable = ( 'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14, 'F' => 15, 'G' => 16, 'H' => 17, 'I' => 18, 'J' => 19, 'K' => 20, 'L' => 21, 'M' => 22, 'N' => 23, 'O' => 24, 'P' => 25, 'Q' => 26, 'R' => 27, 'S' => 28, 'T' => 29, 'U' => 30, 'V' => 31, 'W' => 32, 'X' => 33, 'Y' => 34, 'Z' => 35, ); # Aliases $prefix{'eurocard'} = $prefix{'mastercard'}; # omit prefixes doesn't work with the test numbers my %omitprefix = ( 'jcb' => 0, 'enroute' => 0, 'discover' => 0, ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless( {}, $class ); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ( $self, $number ) = @_; if ( $number =~ /^([0-9A-Z ]*)([0-9])$/i ) { return $2 == $self->_compute_checkdigit( uc($1) ); } return ''; } # is_valid() sub complete { my ( $self, $number ) = @_; if ( $number =~ /^[0-9A-Z ]*$/i ) { return $number . $self->_compute_checkdigit( uc($number) ); } return ''; } # complete() sub basenumber { my ( $self, $number ) = @_; if ( $number =~ /^([0-9A-Z ]*)([0-9])$/i ) { return $1 if ( $2 == $self->_compute_checkdigit( uc($1) ) ); } return ''; } # basenumber() sub checkdigit { my ( $self, $number ) = @_; if ( $number =~ /^([0-9A-Z ]*)([0-9])$/i ) { return $2 if ( $2 == $self->_compute_checkdigit( uc($1) ) ); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/\s//g; if ( $omitprefix{ $self->{type} } ) { my $pf = $prefix{ $self->{type} }; for my $p ( @{$pf} ) { if ( $number =~ /^$p([0-9]+)$/ ) { $number = $1; last; } } } $number =~ s/([A-Z])/$ctable{$1}/ge; # With IMEISV the SV (software version) is left out from the computation # of the checkdigit $number = substr( $number, 0, 14 ) if ( 'imeisv' eq $self->{type} ); if ( $number =~ /^([0-9]*)$/ ) { my @digits = split( //, $number ); my $even = 1; my $sum = 0; for ( my $i = $#digits; $i >= 0; $i-- ) { if ($even) { my $tmp = 2 * $digits[$i]; $sum += $tmp / 10 + $tmp % 10; } else { $sum += $digits[$i]; } $even = not $even; } return ( 10 - $sum % 10 ) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_001 - compute check digits for Bahncard (DE), IMEI, IMEISV, ISIN, Miles&More, Payback (DE), Personnummer (SE), Passport (BR), Credit Cards, SSN (US), Samordningsnummer (SE), VAT RN (ES), VAT RN (IT), VAT RN (SE), International Securities Identifikation Number (ISIN) =head1 SYNOPSIS use Algorithm::CheckDigits; $visa = CheckDigits('visa'); if ($visa->is_valid('4111 1111 1111 1111')) { # do something } $cn = $visa->complete('4111 1111 1111 111'); # $cn = '4111 1111 1111 1111' $cd = $visa->checkdigit('4111 1111 1111 1111'); # $cd = '7' $bn = $visa->basenumber('4111 1111 1111 1111'); # $bn = '4111 1111 1111 111' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning right all numbers are weighted alternatively 1 and 2 (that is the check digit is weighted 1). =item 2 The total of the digits of all products is computed. =item 3 The sum of step 3 ist taken modulo 10. =item 4 The check digit is the difference between 10 and the number from step 3. =back To validate the total of the digits of all numbers inclusive check digit taken modulo 10 must be 0. =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. For IMEI, IMEISV: ETSI Technical Specification TS 100 508 (v6.2.0) =cut Algorithm-CheckDigits-0.50/CheckDigits/M09_001.pm0000644000175000017500000000562611013473143021053 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M09_001; use 5.006; use strict; use warnings; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $class = ref($proto) || $proto; return bless({}, $class); } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([A-Za-z][0-9]{10})([0-9])$/) { return $2 == _compute_checkdigit($1); } return 0; } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[A-Za-z][0-9]{10}$/) { return $number . _compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([A-Za-z][0-9]{10})([0-9])$/) { return $1 if ($2 == _compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([A-Za-z][0-9]{10})([0-9])$/) { return $2 if ($2 == _compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $number = shift; if ($number =~ /^([A-Za-z])([0-9]{10})$/) { my @nums = (); my $sum = 0; push(@nums,ord(uc($1)) - ord('A') +1); push(@nums,split(//,$2)); foreach my $num (@nums) { $sum += $num; } return 8 - ($sum % 9); } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M09_001 - compute check digits for Euro notes =head1 SYNOPSIS use Algorithm::CheckDigits; $euro = CheckDigits('euronote'); if ($euro->is_valid('X07738250357')) { # do something } $cn = $euro->complete('X0773825035'); # $cn = 'X07738250357' $cd = $euro->checkdigit('X07738250357'); # $cd = '7' $bn = $euro->basenumber('X07738250357'); # $bn = 'X0773825035' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Letters are replaced with their position in the alphabet ('A' = 1, ...). =item 2 The total of the digits of all numbers is computed. =item 3 This sum is taken modulo 9. =item 4 The check digit is the difference between 8 and the number of step 3. =back To validate the last digit of the total of the digits of all numbers inclusive check digit must be 8. =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_006.pm0000644000175000017500000000653311013473143021047 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_006; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 6, 3, 7, 9, 10, 5, 8, 4, 2, 1 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{4}-?\d{4})-?(\d\d)-?(\d{10})$/) { return uc($2) eq $self->_compute_checkdigits($1,$3); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{4}-?\d{4})[-\s]+(\d{10})$/) { return "$1-" . $self->_compute_checkdigits($1,$2) . "-$2"; } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{4}-?\d{4})-?(\d\d)-?(\d{10})$/) { return "$1- -$3" if ($2 eq $self->_compute_checkdigits($1,$3)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{4}-?\d{4})-?(\d\d)-?(\d{10})$/) { return $2 if ($2 eq $self->_compute_checkdigits($1,$3)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my $bank = shift; my $account = shift; $bank =~ s/-//g; my $calc = sub { my @digits = split(//,shift); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $digits[$#digits - $i]; } $sum %= 11; return $sum ? 11 - $sum : 0; }; my $first = $calc->($bank); my $second = $calc->($account); return sprintf("%d%d",$first,$second); } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_006 - compute check digits for Código de Cuenta Corriente (ES) =head1 SYNOPSIS use Algorithm::CheckDigits; $ccc = CheckDigits('ccc_es'); if ($ccc->is_valid('2420-0730-27-0050103552')) { # do something } $cn = $ccc->complete('2420-0730- -0050103552'); # $cn = '2420-0730-27-0050103552' $cd = $ccc->checkdigit('2420-0730-27-0050103552'); # $cd = '27' $bn = $ccc->basenumber('2420-0730-27-0050103552'); # $bn = '2420-0730- -0050103552'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning right all digits are weighted 6,3,7,9,10,5,8,4,2,1. =item 2 The weighted digits are added. =item 3 The sum of step 2 is taken modulo 11. =item 4 The checkdigit is 11 minus the sum from step 3. If the difference is 10, the checkdigit is 1. If the difference is 11, the checkdigit is 0. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/M16_001.pm0000644000175000017500000000626511013473143021051 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M16_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([0-9a-f]{15})([0-9a-f])$/i) { return $2 eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[0-9a-f]{15}$/i) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([0-9a-f]{15})([0-9a-f])$/i) { return $1 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([0-9a-f]{15})([0-9a-f])$/i) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^[0-9a-f]{15}$/i) { my ($a,$b,$c); my @digits = split(//,$number); $a = 16; for (my $i = 0; $i <= $#digits; $i++) { $b = ($a % 17) + hex($digits[$i]); $c = $b % 16; $c = 16 unless ($c); $a = 2 * $c; } return sprintf("%X",(17 - ($a % 17)) % 16); } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M16_001 - compute check digits for ISAN =head1 SYNOPSIS use Algorithm::CheckDigits; $isan = CheckDigits('isan'); if ($isan->is_valid('123A567B8912E01A')) { # do something } $cn = $isan->complete('123A567B8912E01'); # $cn = '123A567B8912E01A' $cd = $isan->checkdigit('123A567B8912E01A'); # $cd = '4' $bn = $isan->basenumber('123A567B8912E01A'); # $bn = '123A567B8912E01' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 C C, where C is the decimal value of the hexdigit at position I. C C, for I greater than 1 =item 2 Beginning left for each I = 1..16, C, C, C are computed. =item 3 The check digit is the value for C where C equals 1. =item 4 The check digit is appended as hexadecimal value to the number. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_003.pm0000644000175000017500000000604111013473143021035 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_003; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^M([0-9-]*)([0-9])$/i) { return ($2 == $self->_compute_checkdigit($1)); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^M([0-9-]*[0-9])(-*)$/i) { return "M$1" . '-' . $self->_compute_checkdigit($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^M([0-9-]*[0-9])(-*)([0-9])$/i) { return "M$1" if ($self->is_valid($number)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^M([0-9-]*)([0-9])$/i) { return $2 if ($self->is_valid($number)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/-//g; if ($number =~ /^([0-9]*)$/) { my @digits = split(//,$number); my $even = 0; my $sum = 9; for (my $i = 0; $i <= $#digits; $i++) { if ($even) { $sum += 3 * $digits[$i]; } else { $sum += $digits[$i]; } $even = not $even; } return (10 - ($sum % 10) % 10); } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_003 - compute check digits for ISMN =head1 SYNOPSIS use Algorithm::CheckDigits; $ismn = CheckDigits('ismn'); if ($ismn->is_valid('M-345-24680-5')) { # do something } $cn = $ismn->complete('M-345-24680'); # $cn = 'M-345-24680-5' $cd = $ismn->checkdigit('M-345-24680-5'); # $cd = '5' $bn = $ismn->basenumber('M-345-24680-5'); # $bn = 'M-345-24680' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 The 'M' as the first number gets the value 3. Beginning left all numbers are weighted alternatively 3 and 1. =item 2 The sum of all products is computed. =item 3 The sum of step 3 ist taken modulo 10. =item 4 The check digit is the difference between 10 and the number from step 3 taken modulo 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_008.pm0000644000175000017500000000552611013473143021051 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_008; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 1,3,1,7,3,9,1 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{6})(\d)$/) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^\d{6}$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{6})(\d)$/) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{6})(\d)$/) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^\d{6}$/) { my @digits = split(//,$number); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $digits[$i]; } return (10 - ($sum % 10) % 10); } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_008 - compute check digits for Sedol (GB) =head1 SYNOPSIS use Algorithm::CheckDigits; $sedol = CheckDigits('sedol'); if ($sedol->is_valid('0123457')) { # do something } $cn = $sedol->complete('012345'); # $cn = '0123457' $cd = $sedol->checkdigit('0123457'); # $cd = '7' $bn = $sedol->basenumber('0123457'); # $bn = '012345' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left all numbers are weighted with 1,3,1,7,3,9 and 1 (checkdigit) =item 2 The sum of all products is computed. =item 3 The check digit is the difference of the sum from step 3 to the next multiple of 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_002.pm0000644000175000017500000000570511013473143021043 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_002; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return uc($2) eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[0-9]+$/) { my $cd = $self->_compute_checkdigit($number); return $number . $cd unless 0 > $cd; } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return $1 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(.+)(.)$/) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^[-0-9]+$/) { $number =~ s/-//g; my @digits = split(//,$number); my $sum = 0; my $weight = 2; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight * $digits[$i]; ++$weight; } $sum %= 11; return 10 == $sum ? -1 : $sum; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_002 - compute check digits for PZN (DE) =head1 SYNOPSIS use Algorithm::CheckDigits; $pzn = CheckDigits('pzn'); if ($pzn->is_valid('4877800')) { # do something } $cn = $pzn->complete('487780'); # $cn = '4877800' $cd = $pzn->checkdigit('4877800'); # $cd = '0' $bn = $pzn->basenumber('4877800'); # $bn = '487780' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 From left to right beginning with the first position all digits are multiplied with 2,3,4,... =item 2 The sum of all products is computed. =item 3 The checkdigit ist the sum of step 2 taken modulo 11. =item 4 If the checkdigit is '10' the whole number is not taken as a PZN. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_016.pm0000644000175000017500000000564211013473143021050 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_016; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 6, 5, 7, 2, 3, 4, 5, 6, 7 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{9})(\d)$/) { return $2 == $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{9})$/) { return "$1" . $self->_compute_checkdigits($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{9})(\d)$/) { return $1 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{9})(\d)$/) { return $2 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my @digits = split(//,shift); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $digits[$i]; } $sum %= 11; return $sum; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_016 - compute check digits vor VAT Registration Number (PL) =head1 SYNOPSIS use Algorithm::CheckDigits; $ustid = CheckDigits('ustid_pl'); if ($ustid->is_valid('13669598')) { # do something } $cn = $ustid->complete('1366959'); # $cn = '13669598' $cd = $ustid->checkdigit('13669598'); # $cd = '8' $bn = $ustid->basenumber('13669598'); # $bn = '1366959'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left every digit is weighted with 7,9,10,5,8,4,2. =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 The checkdigit is 11 minus the sum from step 3. Is the difference 10, the number won't be taken. If the difference is 11, the checkdigit is 0. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/MXX_003.pm0000644000175000017500000001023711013473143021156 0ustar mathiasmathiaspackage Algorithm::CheckDigits::MXX_003; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my $perm = [ [ 1, 5, 7, 6, 2, 8, 3, 0, 9, 4, ], [ 5, 8, 0, 3, 7, 9, 6, 1, 4, 2, ], [ 8, 9, 1, 6, 0, 4, 3, 5, 2, 7, ], [ 9, 4, 5, 3, 1, 2, 6, 8, 7, 0, ], [ 4, 2, 8, 6, 5, 7, 3, 9, 0, 1, ], [ 2, 7, 9, 3, 8, 0, 6, 4, 1, 5, ], [ 7, 0, 4, 6, 9, 1, 3, 2, 5, 8, ], [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ], [ 1, 5, 7, 6, 2, 8, 3, 0, 9, 4, ], [ 5, 8, 0, 3, 7, 9, 6, 1, 4, 2, ], [ 8, 9, 1, 6, 0, 4, 3, 5, 2, 7, ], ]; my $dieder = [ [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ], [ 1, 2, 3, 4, 0, 6, 7, 8, 9, 5, ], [ 2, 3, 4, 0, 1, 7, 8, 9, 5, 6, ], [ 3, 4, 0, 1, 2, 8, 9, 5, 6, 7, ], [ 4, 0, 1, 2, 3, 9, 5, 6, 7, 8, ], [ 5, 9, 8, 7, 6, 0, 4, 3, 2, 1, ], [ 6, 5, 9, 8, 7, 1, 0, 4, 3, 2, ], [ 7, 6, 5, 6, 8, 2, 1, 0, 4, 3, ], [ 8, 7, 6, 5, 9, 3, 2, 1, 0, 4, ], [ 9, 8, 7, 6, 5, 4, 3, 2, 1, 0, ], ]; sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([ADGKLNSUYZ]{2}\d{7}[ADGKLNSUYZ])(\d)$/i) { return 1 if ($2 == $self->_compute_checkdigit(uc($1))); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[ADGKLNSUYZ]{2}\d{7}[ADGKLNSUYZ]$/i) { return $number . $self->_compute_checkdigit(uc($number)); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([ADGKLNSUYZ]{2}\d{7}[ADGKLNSUYZ])(\d)$/i) { return $1 if ($2 == $self->_compute_checkdigit(uc($1))); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([ADGKLNSUYZ]{2}\d{7}[ADGKLNSUYZ])(\d)$/i) { return $2 if ($2 == $self->_compute_checkdigit(uc($1))); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ tr/ADGKLNSUYZ/0-9/; my @digits = split(//,$number); my $p0 = $perm->[0]->[$digits[0]]; my $rd = $p0; for (my $i = 1; $i <= $#digits; $i++) { my $pi = $perm->[$i % 8]->[$digits[$i]]; $rd = $dieder->[$rd]->[$pi]; } for (my $j = 0; $j <= 9; $j++) { return $j unless($dieder->[$rd]->[$j]); } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MXX_003 - compute check digits for DEM =head1 SYNOPSIS use Algorithm::CheckDigits; $dem = CheckDigits('dem'); if ($dem->is_valid('GD0645027K1')) { # do something } $cn = $dem->complete('GD0645027K'); # $cn = 'GD0645027K1' $cd = $dem->checkdigit('GD0645027K1'); # $cd = '1' $bn = $dem->basenumber('GD0645027K1'); # $bn = 'GD0645027K' =head1 DESCRIPTION =head2 ALGORITHM The algorithm is a variation of the Verhoeff scheme. =over 4 =item 0 All letters are changed to numbers. =item 1 All digits are permutated according to a permutation table. =item 2 The permutated digits are combined using a diëder table. The first with the second, the result with the third, this result with the fourth and so on. =item 3 The result of the last combination in the diëder table is in such a way combined that the result is 0 (zero). The number used for this combination is the checksum. =back For details look at the source. =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 THANKS =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_011.pm0000644000175000017500000000750611013473143021044 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_011; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([0-9]+)(\d)(B\d\d)?$/i) { return $2 == $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^([0-9]+)(?:.(B\d\d))?$/ and (my $cd = $self->_compute_checkdigits($1)) ne '') { my $tail = $2 || ''; return $1 . $cd . $tail; } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([0-9]+)(\d)(B\d\d)?$/i) { my $tail = $3 ? ".$3" : ''; return $1 . $tail if ($2 == $self->_compute_checkdigits($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([0-9]+)(\d)(B\d\d)?$/) { return $2 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my $number = shift; $number =~ s/\.//g; my @digits = split(//,$number); my $len = scalar(@digits) + 1; my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += ($len - $i) * $digits[$i]; } $sum %= 11; return ($sum == 10) ? '' : $sum; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_011 - compute check digits for VAT Registration Number (NL) =head1 SYNOPSIS use Algorithm::CheckDigits; $ustid = CheckDigits('ustid_nl'); if ($ustid->is_valid('123456782')) { # do something } if ($ustid->is_valid('123456782B04')) { # do something } $cn = $ustid->complete('12345678'); # $cn = '123456782' $cn = $ustid->complete('12345678.B04'); # $cn = '123456782B04' $cd = $ustid->checkdigit('123456782'); # $cd = '2' $cd = $ustid->checkdigit('123456782B04'); # $cd = '2' $bn = $ustid->basenumber('123456782'); # $bn = '12345678'; $bn = $ustid->basenumber('123456782B04'); # $bn = '12345678.B04'; =head1 DESCRIPTION This VATRN has 12 "digits", the third last must be a I, the fourth last is the checkdigit. I don't know anything about the meaning of the last two digits. You may use the whole VATRN or only the first eight digits to compute the checkdigit with this module. =head2 ALGORITHM =over 4 =item 1 Beginning right with the digit before the checkdigit all digits are weighted with their position. I.e. the digit before the checkdigit is multiplied with 2, the next with 3 and so on. =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 If the sum from step 3 is 10, the number is discarded. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 SEE ALSO L, L, F, =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 COPYRIGHT AND LICENSE Copyright 2004,2005 by Mathias Weidner This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Algorithm-CheckDigits-0.50/CheckDigits/M23_002.pm0000644000175000017500000000611611013473143021043 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M23_002; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @keytable = ( 'W', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{7})([A-W])$/i) { return $2 eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{7})$/i) { return $number . $self->_compute_checkdigit($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{7})([A-W])$/i) { return $1 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{7})([A-W])$/i) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; my $sum = 0; my @digits = split(//,$number); for (my $i = 0; $i < 7; $i++) { $sum += $digits[$i] * (8-$i); } return $keytable[$sum % 23]; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M23_002 - compute check digits for VAT Registration Number (IE) =head1 SYNOPSIS use Algorithm::CheckDigits; $dni = CheckDigits('ustid_ie'); if ($dni->is_valid('8473625E')) { # do something } $cn = $dni->complete('8473625'); # $cn = '8473625E' $cd = $dni->checkdigit('8473625E'); # $cd = 'E' $bn = $dni->basenumber('8473625E'); # $bn = '8473625' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning right all digits are weighted with their position in the number (i.e. the number left from the check digit is multiplied with 2, the next with 3 and so on). =item 2 All products are added. =item 3 The check digit is the sum from step 2 modulo 23. This number is expressed as the corresponding letter from the alphabet where A-V correspond to 1-22 and W stands for check digit 0. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M43_001.pm0000644000175000017500000000633711013473143021051 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M43_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my %keytable = ( '0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4, '5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9, 'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14, 'F' => 15, 'G' => 16, 'H' => 17, 'I' => 18, 'J' => 19, 'K' => 20, 'L' => 21, 'M' => 22, 'N' => 23, 'O' => 24, 'P' => 25, 'Q' => 26, 'R' => 27, 'S' => 28, 'T' => 29, 'U' => 30, 'V' => 31, 'W' => 32, 'X' => 33, 'Y' => 34, 'Z' => 35, '-' => 36, '.' => 37, ' ' => 38, '$' => 39, '/' => 40, '+' => 41, '%' => 42, ); my %keymap = reverse %keytable; sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/i) { return $2 eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(.*)$/i) { return $number . $self->_compute_checkdigit($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/i) { return $1 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/i) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; my $sum = 0; my @digits = split(//,$number); for (my $i = 0; $i < length($number); $i++) { $sum += $keytable{$digits[$i]}; } $sum %= 43; return $keymap{$sum}; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M43_001 - compute check digits for Code-39 =head1 SYNOPSIS use Algorithm::CheckDigits; $c39 = CheckDigits('code_39'); if ($c39->is_valid('AB-123K')) { # do something } $cn = $c39->complete('AB-123'); # $cn = 'AB-123K' $cd = $c39->checkdigit('AB-123K'); # $cd = 'K' $bn = $c39->basenumber('AB-123K'); # $bn = 'AB-123' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 After replacing all non numeric letters with their respective values, the sum of all numbers is computers =item 2 The checkdigit is the sum from step 1 taken modulo 43. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_017.pm0000644000175000017500000000614011013473143021043 0ustar mathiasmathias# vim: set ts=4 sw=4 tw=78 si et: package Algorithm::CheckDigits::M11_017; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless( {}, $class ); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ( $self, $number ) = @_; if ( $number =~ /^([-\d]+)(\d)$/ ) { return $2 eq $self->_compute_checkdigit($1); } return ''; } # is_valid() sub complete { my ( $self, $number ) = @_; if ( $number =~ /^[-\d]+$/ ) { my $cd = $self->_compute_checkdigit($number); return $number . $cd unless 0 > $cd; } return ''; } # complete() sub basenumber { my ( $self, $number ) = @_; if ( $number =~ /^([-\d]+)(\d)$/ ) { return $1 if ( $2 eq $self->_compute_checkdigit($1) ); } return ''; } # basenumber() sub checkdigit { my ( $self, $number ) = @_; if ( $number =~ /^([-\d.]+)(\d)$/ ) { return $2 if ( $2 eq $self->_compute_checkdigit($1) ); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; my ( $cd1, $cd2 ) = ( '', '' ); $number =~ s/[-]//g; my @digits = split //, $number; my $sum = 0; for ( my $i = 0; $i <= $#digits; $i++ ) { $sum += ( $i + 1 ) * $digits[$i]; } $sum %= 11; return 0 if ( 9 < $sum ); return $sum; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_017 - compute check digits for EC-No, EINECS, ELINCS =head1 SYNOPSIS use Algorithm::CheckDigits; $ecno = CheckDigits('ecno'); if ($ecno->is_valid('200-236-6')) { # do something } $cn = $ecno->complete('200-236-'); # $cn = '200-236-6' $cd = $ecno->checkdigit('200-236-6'); # $cd = '6' $bn = $ecno->basenumber('200-236-6'); # $bn = '200-236-' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 From left to right all digits are multiplied with their position in the sequence. =item 2 The sum of all products is computed. =item 3 The sum of step 2 is taken modulo 11. The checkdigit is the last digit of the result. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_007.pm0000644000175000017500000000570411013473143021047 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_007; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 7, 9, 10, 5, 8, 4, 2 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{7})(\d)$/) { return uc($2) eq $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{7})$/) { return "$1" . $self->_compute_checkdigits($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{7})(\d)$/) { return $1 if ($2 eq $self->_compute_checkdigits($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{7})(\d)$/) { return $2 if ($2 eq $self->_compute_checkdigits($1)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my @digits = split(//,shift); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $digits[$i]; } $sum %= 11; return $sum ? ($sum == 1 ? '' : 11 - $sum) : 0; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_007 - compute check digits for VAT Registration Number (FI) =head1 SYNOPSIS use Algorithm::CheckDigits; $ustid = CheckDigits('ustid_fi'); if ($ustid->is_valid('13669598')) { # do something } $cn = $ustid->complete('1366959'); # $cn = '13669598' $cd = $ustid->checkdigit('13669598'); # $cd = '8' $bn = $ustid->basenumber('13669598'); # $bn = '1366959'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left every digit is weighted with 7,9,10,5,8,4,2. =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 The checkdigit is 11 minus the sum from step 3. Is the difference 10, the number won't be taken. If the difference is 11, the checkdigit is 0. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_011.pm0000644000175000017500000000602611013473143021037 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_011; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(.*)([0-9])$/) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; my $cd = $self->_compute_checkdigit($number); if ($cd != -1) { return $number . $cd; } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(.*)([0-9])$/) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(.*)([0-9])$/) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/\s//g; $number =~ s/^1z//i; $number =~ y/[A-Za-z]/[2-9][0-9][0-7][2-9][0-9][0-7]/; if ($number =~ /^([0-9]*)$/) { my @digits = split(//,$number); my $even = 0; my $sum = 0; foreach my $digit (@digits) { $sum += $digit; $sum += $digit if ($even); $even = not $even; } return (10 - $sum % 10) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_011 - compute check digits UPS (US) =head1 SYNOPSIS use Algorithm::CheckDigits; $ups = CheckDigits('ups'); if ($ups->is_valid('1Z 591580 68 55587736')) { # do something } $cn = $ups->complete('1Z 591580 68 5558773'); # $cn = '1Z 591580 68 55587736' $cd = $ups->checkdigit('1Z 591580 68 55587736'); # $cd = '6' $bn = $ups->basenumber('1Z 591580 68 55587736'); # $bn = '1Z 591580 68 5558773' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left all numbers are weighted alternatively 1 and 2. =item 2 The sum of all products is computed. =item 3 The sum of step 3 ist taken modulo 10. =item 4 The check digit is the difference between 10 and the number from step 3. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/MXX_006.pm0000644000175000017500000001050211013473143021154 0ustar mathiasmathiaspackage Algorithm::CheckDigits::MXX_006; use 5.006; use strict; use warnings; use integer; use Data::Dumper; our @ISA = qw(Algorithm::CheckDigits); our @inverted = (0, 4, 3, 2, 1, 5, 6, 7, 8, 9 ); my $perm = [ [ 1, 5, 7, 6, 2, 8, 3, 0, 9, 4, ], [ 5, 8, 0, 3, 7, 9, 6, 1, 4, 2, ], [ 8, 9, 1, 6, 0, 4, 3, 5, 2, 7, ], [ 9, 4, 5, 3, 1, 2, 6, 8, 7, 0, ], [ 4, 2, 8, 6, 5, 7, 3, 9, 0, 1, ], [ 2, 7, 9, 3, 8, 0, 6, 4, 1, 5, ], [ 7, 0, 4, 6, 9, 1, 3, 2, 5, 8, ], [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ], [ 1, 5, 7, 6, 2, 8, 3, 0, 9, 4, ], [ 5, 8, 0, 3, 7, 9, 6, 1, 4, 2, ], [ 8, 9, 1, 6, 0, 4, 3, 5, 2, 7, ], ]; my $dieder = [ [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ], [ 1, 2, 3, 4, 0, 6, 7, 8, 9, 5, ], [ 2, 3, 4, 0, 1, 7, 8, 9, 5, 6, ], [ 3, 4, 0, 1, 2, 8, 9, 5, 6, 7, ], [ 4, 0, 1, 2, 3, 9, 5, 6, 7, 8, ], [ 5, 9, 8, 7, 6, 0, 4, 3, 2, 1, ], [ 6, 5, 9, 8, 7, 1, 0, 4, 3, 2, ], [ 7, 6, 5, 6, 8, 2, 1, 0, 4, 3, ], [ 8, 7, 6, 5, 9, 3, 2, 1, 0, 4, ], [ 9, 8, 7, 6, 5, 4, 3, 2, 1, 0, ], ]; sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/i) { return 1 if ($2 == $self->_compute_checkdigit(uc($1))); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^\d+$/i) { return $number . $self->_compute_checkdigit(uc($number)); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/i) { return $1 if ($2 == $self->_compute_checkdigit(uc($1))); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/i) { return $2 if ($2 == $self->_compute_checkdigit(uc($1))); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; my $input = shift; my $c = 0; # initialize check at 0 my $digit = 0; my $i = 0; my $r; foreach $digit (reverse split(//, $number)) { # This was jonathans implementation, his permutation # table is offset by one compared to the one I already # took in MXX_003.pm and reused here # $c = $di->[$c]->[$f->[($i+1) % 8]->[$digit]]; $c = $dieder->[$c]->[$perm->[$i % 8]->[$digit]]; $i++; } return $inverted[$c]; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MXX_006 - compute check digits with Verhoeff scheme =head1 SYNOPSIS use Algorithm::CheckDigits; $verhoeff = CheckDigits('verhoeff'); if ($verhoeff->is_valid('14567894')) { # do something } $cn = $verhoeff->complete('1456789'); # $cn = '14567894' $cd = $verhoeff->checkdigit('14567894'); # $cd = '4' $bn = $verhoeff->basenumber('14567894'); # $bn = '1456789' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Right to left all digits are permutated according to a permutation table. =item 2 The permutated digits are combined using a diëder table. The first with the second, the result with the third, this result with the fourth and so on. =item 3 The result of the last combination in the diëder table is in such a way combined that the result is 0 (zero). The number used for this combination is the checksum. =back For details look at the source. =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 THANKS Jonathan Peters wrote L from which I took the routine to compute the checkdigits. =head1 SEE ALSO L, L, L, L =cut Algorithm-CheckDigits-0.50/CheckDigits/M89_001.pm0000644000175000017500000000527211013473143021060 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M89_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @keytable = ( 'T', 'R', 'W', 'A', 'G', 'M', 'Y', 'F', 'P', 'D', 'X', 'B', 'N', 'J', 'Z', 'S', 'Q', 'V', 'H', 'L', 'C', 'K', 'E', ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d{6})?(\d\d)$/i) { return $2 eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{6})$/i) { return $number . $self->_compute_checkdigit($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{6})(\d\d)$/i) { return $1 if ($2 eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d{6})(\d\d)$/i) { return $2 if (uc($2) eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^\d{6}$/i) { return sprintf("%2.2d",($number % 89)); } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M89_001 - compute check digits for VAT Registration Number (LU) =head1 SYNOPSIS use Algorithm::CheckDigits; $ustid = CheckDigits('ustid_lu'); if ($ustid->is_valid('13669580')) { # do something } $cn = $ustid->complete('136695'); # $cn = '13669580' $cd = $ustid->checkdigit('13669580'); # $cd = '80' $bn = $ustid->basenumber('13669580'); # $bn = '136695' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 The checksum is the whole number taken modulo 89. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_004.pm0000644000175000017500000001021711013473143021036 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_004; # vim: set tw=78 sw=4 ts=4 si sr et: use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my $valid_prefix = { isbn13 => { 978 => 1, 979 => 1, }, issn13 => { 977 => 1, }, }; sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless( {}, $class ); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ( $self, $number ) = @_; if ( $number =~ /^([0-9 -]+)([0-9])$/ ) { return $2 == $self->_compute_checkdigit($1); } return ''; } # is_valid() sub complete { my ( $self, $number ) = @_; if ( $number =~ /^[0-9 -]+$/ ) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ( $self, $number ) = @_; if ( $number =~ /^([0-9 -]+)([0-9])$/ ) { return $1 if ( $2 == $self->_compute_checkdigit($1) ); } return ''; } # basenumber() sub checkdigit { my ( $self, $number ) = @_; if ( $number =~ /^([0-9 -]+)([0-9])$/ ) { return $2 if ( $2 == $self->_compute_checkdigit($1) ); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/[ -]//g; if ( $number =~ /^([0-9]*)$/ ) { if ( $valid_prefix->{ $self->{type} } ) { my $prefix = substr $number, 0, 3; unless ( $valid_prefix->{ $self->{type} }->{$prefix} ) { return -1; } } my @digits = split( //, $number ); my $even = 1; my $sum = 0; for ( my $i = $#digits; $i >= 0; $i-- ) { if ($even) { $sum += 3 * $digits[$i]; } else { $sum += $digits[$i]; } $even = not $even; } return ( 10 - $sum % 10 ) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_004 - compute check digits for 2aus5, EAN, ILN, ISBN13, NVE =head1 SYNOPSIS use Algorithm::CheckDigits; $ean = CheckDigits('ean'); if ($ean->is_valid('7622200004607')) { # do something } $cn = $ean->complete('762220000460'); # $cn = '7622200004607' $cd = $ean->checkdigit('7622200004607'); # $cd = '7' $bn = $ean->basenumber('7622200004607'); # $bn = '762220000460' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning right all numbers are weighted alternatively 1 and 3 (that is the check digit is weighted 1). =item 2 The sum of all products is computed. =item 3 The sum of step 3 ist taken modulo 10. =item 4 The check digit is the difference between 10 and the number from step 3. =back To validate the total of the digits of all numbers inclusive check digit taken modulo 10 must be 0. =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of digits, spaces and hyphen and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, spaces and hyphen. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 BUGS AND LIMITATIONS When invoked as C the module checks whether the first three digits (the country code) are 978 or 979, the current (as of 2006) EAN country codes for books. If at any time other EAN country codes for ISBN-13 will be specified and the then responsible maintainer ignores this in the code, please send a friendly email. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M97_002.pm0000644000175000017500000001131511013473143021053 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M97_002; # vim: set sw=4 ts=4 tw=78 et si: use 5.006; use strict; use warnings; use integer; #use Math::BigInt; our @ISA = qw(Algorithm::CheckDigits); my %subst = ( A => 10, B => 11, C => 12, D => 13, E => 14, F => 15, G => 16, H => 17, I => 18, J => 19, K => 20, L => 21, M => 22, N => 23, O => 24, P => 25, Q => 26, R => 27, S => 28, T => 29, U => 30, V => 31, W => 32, X => 33, Y => 34, Z => 35, ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my $self = shift; if (my ($checkdigit,$number) = _prepare_number(shift)) { return $checkdigit eq _compute_checkdigit($number); } return '' } # is_valid() sub complete { my $self = shift; my $incomplete = uc(shift); if (my ($checkdigit,$number) = _prepare_number($incomplete)) { $incomplete =~ /^(..)..(.+)/; return $1 . _compute_checkdigit($number) . $2; } return ''; } # complete() sub basenumber { my $self = shift; my $unchecked = shift; if (my ($checkdigit,$number) = _prepare_number($unchecked)) { $unchecked =~ /^(..)..(.+)/; return $1.'00'.$2 if ($checkdigit eq _compute_checkdigit($number)); } return ''; } # basenumber() sub checkdigit { my $self = shift; if (my ($checkdigit,$number) = _prepare_number(shift)) { return $checkdigit if ($checkdigit eq _compute_checkdigit($number)); } return ''; } # checkdigit() sub _compute_checkdigit { my $number = shift; # my $bignum = Math::BigInt->new($number); # my $mod = $bignum % 97; # # A comparison with Benchmark::compthese() brought: # # Rate bignum 9_digits # bignum 2502/s -- -95% # 9_digits 46225/s 1748% -- # # so I reverted _compute_checkdigit to this code. # Thanks to Detlef Pilzecker for making me aware of this. my $mod = ''; while ($number ne '') { $number = $mod . $number; $mod = substr($number,0,9,'') % 97; } return sprintf("%02d",(98 - $mod)); } # _compute_checkdigit() sub _prepare_number { my $number = uc(shift); $number =~ s/\s//g; if ($number =~ /^([A-Z]{2})(\d\d)([A-Z\d]{2,30})$/) { my $checkdigit = $2; $number = $3 . $1 . '00'; $number =~ s/([A-Z])/$subst{$1}/g; return ($checkdigit,$number); } return; } # _prepare_number() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M97_002 - compute check digits for International Bank Account Number (IBAN) =head1 SYNOPSIS use Algorithm::CheckDigits; $iban = CheckDigits('iban'); if ($iban->is_valid('DE88 2008 0000 09703 7570 0')) { # do something } $cn = $iban->complete('DE00 2008 0000 09703 7570 0'); # $cn = 'DE88 2008 0000 09703 7570 0' $cd = $iban->checkdigit('DE88 2008 0000 09703 7570 0'); # $cd = '88' $bn = $iban->basenumber('DE88 2008 0000 09703 7570 0'); # $bn = 'DE00 2008 0000 09703 7570 0' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 0 The IBAN number must be prepared. The first two letters and the checksum will be moved to the right end. The letters are substituted according to the substitute table and the checksum is set to '00'. =item 1 The whole number is taken modulo 97. =item 2 The checksum is difference between 98 and the sum of step 2. =item 3 If the checksum is smaller then 10, a leading zero will be prepended. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigits of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 THANKS Detlef Pilzecker pointed out to me that there may be more letters as the first two in an IBAN number. He also made me aware of a faster method to compute the check number than using Math::BigInt. =head1 SEE ALSO L, L, F, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_004.pm0000644000175000017500000000705011013473143021040 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_004; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([-\d.]+)(\d\d)$/) { return $2 eq $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[-\d.]+$/) { my $cd = $self->_compute_checkdigit($number); return $number . $cd unless 0 > $cd; } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([-\d.]+)(\d\d)$/) { return $1 if ($2 eq $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([-\d.]+)(\d\d)$/) { return $2 if ($2 eq $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; my ($cd1,$cd2) = ('',''); my $calc_cd = sub { my $number = shift; my $weight = shift; my @digits = split(//,$number); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight * $digits[$i]; --$weight; }; $sum %= 11; return 0 if (2 > $sum); return 11 - $sum; }; return -1 unless ($number =~ /^[-\d.]+$/); $number =~ s/[-.]//g; if ('cpf' eq $self->{type}) { return -1 unless length($number) == 9; $cd1 = $calc_cd->($number,10); $cd2 = $calc_cd->($number . $cd1,11); } elsif ('titulo_eleitor' eq $self->{type}) { $number = substr("00000000000" . $number, -10); $cd1 = $calc_cd->(substr($number,0,8),9); $cd2 = $calc_cd->(substr($number,-2) . $cd1,4); } return $cd1 . $cd2; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_004 - compute check digits for CPF (BR), Título Eleitoral (BR) =head1 SYNOPSIS use Algorithm::CheckDigits; $cpf = CheckDigits('cpf'); if ($cpf->is_valid('043.033.407-90')) { # do something } $cn = $cpf->complete('043.033.407-'); # $cn = '043.033.407-90' $cd = $cpf->checkdigit('043.033.407-90'); # $cd = '90' $bn = $cpf->basenumber('043.033.407-90'); # $bn = '043.033.407-' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 From left to right all digits are multiplied with their position in the sequence. =item 2 The sum of all products is computed. =item 3 The sum of step 2 is taken modulo 11. a) If the result is 0 or 1 the checkdigit is 0 b) otherwise the checkdigit is 11 minus the result. =item 4 The first checkdigit is appended to the number and step 1 to 3 are repeated. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/MBase_001.pm0000644000175000017500000000634511013473143021474 0ustar mathiasmathiaspackage Algorithm::CheckDigits::MBase_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/) { return $2 == $self->_compute_checkdigit($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^\d+$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/) { return $1 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(\d+)(\d)$/) { return $2 if ($2 == $self->_compute_checkdigit($1)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; if ($number =~ /^\d+$/) { my @digits = split(//,$number); my $sum = 0; my $even = 0; for (my $i = 0; $i <= $#digits; $i++) { if ($even) { $sum += $digits[$i]; } else { $sum += 3 * $digits[$i]; } $even = not $even; } return (10 - ($sum % 10)) % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MBase_001 - compute check digits for UPC (US) =head1 SYNOPSIS use Algorithm::CheckDigits; $rv = CheckDigits('upc'); if ($rv->is_valid('012345678905')) { # do something } $cn = $rv->complete('01234567890'); # $cn = '012345678905' $cd = $rv->checkdigit('012345678905'); # $cd = '5' $bn = $rv->basenumber('012345678905'); # $bn = '01234567890' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Add all digits in odd-numbered positions. =item 2 Multiply the sum from step 1 with 3. =item 3 Add all digits in even-numbered positions. =item 4 Add the product from step 2 and the sum from step 3. =item 5 If the sum from step 4 is 0 modulo 10, the check digit is 0. Else the check digit is 10 minus the sum from step 4 taken modulo 10. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 THANKS Aaron W. West pointed me to a fault in the computing of the check digit. =head1 SEE ALSO L, L, F, F, F, F. =cut Algorithm-CheckDigits-0.50/CheckDigits/M11_010.pm0000644000175000017500000000601511013473143021035 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M11_010; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 5, 4, 3, 2, 7, 6, 5, 4, 3, 2 ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([0-9.]+)(\d)$/) { return $2 == $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^([0-9.]+)$/) { return "$1" . $self->_compute_checkdigits($1); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([0-9.]+)(\d)$/) { return $1 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([0-9.]+)(\d)$/) { return $2 if ($2 == $self->_compute_checkdigits($1)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my $number = shift; $number =~ s/\.//g; my @digits = split(//,$number); my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { $sum += $weight[$i] * $digits[$i]; } $sum %= 11; return $sum == 0 ? 0 : ($sum == 1 ? '' : 11 - $sum); } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M11_010 - compute check digits AHV number (CH) =head1 SYNOPSIS use Algorithm::CheckDigits; $ahv = CheckDigits('ahv_ch'); if ($ahv->is_valid('123.45.678.113')) { # do something } $cn = $ahv->complete('123.45.678.11'); # $cn = '123.45.678.113' $cd = $ahv->checkdigit('123.45.678.113'); # $cd = '3' $bn = $ahv->basenumber('123.45.678.113'); # $bn = '123.45.678.11'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left every digit is weighted with 5,4,3,2,7,6,5,4,3,2. =item 2 The weighted digits are added. =item 3 The sum from step 2 is taken modulo 11. =item 4 The checkdigit is 11 minus the sum from step 3. Is the difference 10, the number won't be taken. If the difference is 11, the checkdigit is 0. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, =cut Algorithm-CheckDigits-0.50/CheckDigits/M10_009.pm0000644000175000017500000000643611013473143021053 0ustar mathiasmathiaspackage Algorithm::CheckDigits::M10_009; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^([0-9 ]*)([0-9])$/) { my $cd = $self->_compute_checkdigit($1); return ($2 == $cd || $2 == ((5 + $cd) % 10)); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^[0-9 ]*$/) { return $number . $self->_compute_checkdigit($number); } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^([0-9 ]*)([0-9])$/) { return $1 if ($self->is_valid($number)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^([0-9 ]*)([0-9])$/) { return $2 if ($self->is_valid($number)); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; $number =~ s/\s//g; if ($number =~ /^([0-9]*)$/) { my @digits = split(//,$number); my $even = 0; my $sum = 0; for (my $i = 0; $i <= $#digits; $i++) { if ($even) { my $tmp = 2 * $digits[$i]; $sum += $tmp / 10 + $tmp % 10; } else { $sum += $digits[$i]; } $even = not $even; } return $sum % 10; } return -1; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::M10_009 - compute check digits for Betriebsnummer (DE) =head1 SYNOPSIS use Algorithm::CheckDigits; $betrnr = CheckDigits('betriebsnummer'); if ($betrnr->is_valid('73282932000074')) { # do something } $cn = $betrnr->complete('7328293200007'); # $cn = '73282932000074' $cd = $betrnr->checkdigit('73282932000074'); # $cd = '4' $bn = $betrnr->basenumber('73282932000074'); # $bn = '7328293200007' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left all numbers are weighted alternatively 1 and 2. =item 2 The total of the digits of all products is computed. =item 3 The sum of step 3 ist taken modulo 10. =item 4 The check digit is the difference between 10 and the number from step 3 taken modulo 10. HINT: The last digit of the 'Betriebsnummer' may be the check digit or the last digit of the sum of the constant 5 and the check digit. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F. F =cut Algorithm-CheckDigits-0.50/CheckDigits/MXX_001.pm0000644000175000017500000001000511013473143021145 0ustar mathiasmathiaspackage Algorithm::CheckDigits::MXX_001; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1, ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^\d{9}(\d).<+\d{6}(\d)<+\d{6}(\d)<+(\d)$/) { my @cd = $self->_compute_checkdigit($number); return 1 if ( $cd[0] == $1 and $cd[1] == $2 and $cd[2] == $3 and $cd[3] == $4 ); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(\d{9}).(.<+\d{6}).(<+\d{6}).(<+).$/) { my @cd = $self->_compute_checkdigit($number); return $1 . $cd[0] . $2 . $cd[1] . $3 . $cd[2] . $4 . $cd[3]; } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(\d{9})(\d)(.<+\d{6})(\d)(<+\d{6})(\d)(<+)(\d)$/) { my @cd = $self->_compute_checkdigit($number); return $1 . '_' . $3 . '_' . $5 . '_' . $7 . '_' if ( $cd[0] == $2 and $cd[1] == $4 and $cd[2] == $6 and $cd[3] == $8 ); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^\d{9}(\d).<+\d{6}(\d)<+\d{6}(\d)<+(\d)$/) { my @cd = $self->_compute_checkdigit($number); return join('<',@cd) if ( $cd[0] == $1 and $cd[1] == $2 and $cd[2] == $3 and $cd[3] == $4 ); } return ''; } # checkdigit() sub _compute_checkdigit { my $self = shift; my $number = shift; my $compute = sub { my $digits = shift; my ($sum,$i) = (0,0); while ($digits =~ /(\d)/g) { $sum += $1 * $weight[$i++]; } return $sum % 10; }; if ($number =~ /^(\d{9})..<+(\d{6}).<+(\d{6}).<+.$/) { my @cd; $cd[0] = $compute->($1); $cd[1] = $compute->($2); $cd[2] = $compute->($3); $cd[3] = $compute->($1 . $cd[0] . $2 . $cd[1] . $3 . $cd[2]); return @cd; } return (); } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MXX_001 - compute check digits for PA (DE) =head1 SYNOPSIS use Algorithm::CheckDigits; $pa = CheckDigits('pa_de'); if ($pa->is_valid('2406055684D<<6810203<0705109<6')) { # do something } $cn = $pa->complete('240605568_D<<681020_<070510_<_'); # $cn = '2406055684D<<6810203<0705109<6' $cd = $pa->checkdigit('2406055684D<<6810203<0705109<6'); # $cd = '6' $bn = $pa->basenumber('2406055684D<<6810203<0705109<6'); # $bn = '240605568_D<<681020_<070510_<_' =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 1 Beginning left all digits are weighted with 7,3,1,7,3,1,... =item 2 The sum of those products is computed. =item 3 The checksum is the last digit of the sum from step 2 (modulo 10). =item 4 Step 1 to 3 is performed for every part of the number and for all 3 parts including the particular checkdigit to compute the total checksum. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and the last digit is a valid check digit according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and concatenated to the end of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the checkdigit of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 THANKS Aaron W. West pointed me to a fault in the computing of the check digit. =head1 SEE ALSO L, L, F, F, F, F. =cut Algorithm-CheckDigits-0.50/META.yml0000644000175000017500000000047311022312327016647 0ustar mathiasmathias# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Algorithm-CheckDigits version: 0.50 version_from: CheckDigits.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30_01 Algorithm-CheckDigits-0.50/.perltidyrc0000644000175000017500000000027111013473143017560 0ustar mathiasmathias-ci=2 -i=4 -l=78 -cti=0 -pt=1 -bt=1 -sbt=1 -bbt=1 -nsfs -nolc -nolq -ple -sct -se -st -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" Algorithm-CheckDigits-0.50/README0000644000175000017500000000067211013473143016263 0ustar mathiasmathiasCheckDigits version 0.01 ======================== This module provides several procedures to compute or validate check digits. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires no other modules and libraries. COPYRIGHT AND LICENCE Copyright (C) 2003 Mathias Weidner This module may be distributed under the same license as perl itself. Algorithm-CheckDigits-0.50/MANIFEST0000644000175000017500000000233711022312327016530 0ustar mathiasmathiasChanges CheckDigits/M07_001.pm CheckDigits/M09_001.pm CheckDigits/M10_001.pm CheckDigits/M10_002.pm CheckDigits/M10_003.pm CheckDigits/M10_004.pm CheckDigits/M10_005.pm CheckDigits/M10_006.pm CheckDigits/M10_008.pm CheckDigits/M10_009.pm CheckDigits/M10_010.pm CheckDigits/M10_011.pm CheckDigits/M11_001.pm CheckDigits/M11_002.pm CheckDigits/M11_003.pm CheckDigits/M11_004.pm CheckDigits/M11_006.pm CheckDigits/M11_007.pm CheckDigits/M11_008.pm CheckDigits/M11_009.pm CheckDigits/M11_010.pm CheckDigits/M11_011.pm CheckDigits/M11_012.pm CheckDigits/M11_013.pm CheckDigits/M11_015.pm CheckDigits/M11_016.pm CheckDigits/M11_017.pm CheckDigits/M16_001.pm CheckDigits/M23_001.pm CheckDigits/M23_002.pm CheckDigits/M43_001.pm CheckDigits/M89_001.pm CheckDigits/M97_001.pm CheckDigits/M97_002.pm CheckDigits/MBase_001.pm CheckDigits/MBase_002.pm CheckDigits/MBase_003.pm CheckDigits/MXX_001.pm CheckDigits/MXX_002.pm CheckDigits/MXX_003.pm CheckDigits/MXX_004.pm CheckDigits/MXX_005.pm CheckDigits/MXX_006.pm CheckDigits.pm Makefile.PL MANIFEST .perltidyrc README t/checkdigits.t t/ecno.t t/iban.t t/imei.t t/isbn13.t t/pod-coverage.t t/pod.t t/upc.t t/valid.data t/valid.t META.yml Module meta-data (added by MakeMaker) Algorithm-CheckDigits-0.50/Makefile.PL0000644000175000017500000000106311022312061017337 0ustar mathiasmathias BEGIN { require 5.006 } use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Algorithm::CheckDigits', 'VERSION_FROM' => 'CheckDigits.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'CheckDigits.pm', # retrieve abstract from module AUTHOR => 'Mathias Weidner ') : ()), );