Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

ABN checker

by bgroper (Novice)
on Feb 06, 2019 at 10:30 UTC ( #1229460=perlquestion: print w/replies, xml ) Need Help??

bgroper has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks

Newbie here, so thanks for being gentle.

I'm needing a procedure to check Australian Business Numbers (aka ABN's).

The simple algorithm is described at https://abr.business.gov.au/Help/AbnFormat

I've hacked the short procedure copied below, but I suspect it could be improved.

I don't do this often, so would be really grateful for any tips and/or clues.

TIA's

sub Check_ABN { my $number = shift ; my $abn_invalid = 0 ; my $sum = 0 ; $number =~ s/\ //g ; unless (length($number) eq 11) { $abn_invalid = 1 ; return $abn_invalid ; } $sum += (substr($number,0,1)-1)*10 ; $sum += substr($number,1,1)*1 ; $sum += substr($number,2,1)*3 ; $sum += substr($number,3,1)*5 ; $sum += substr($number,4,1)*7 ; $sum += substr($number,5,1)*9 ; $sum += substr($number,6,1)*11 ; $sum += substr($number,7,1)*13 ; $sum += substr($number,8,1)*15 ; $sum += substr($number,9,1)*17 ; $sum += substr($number,10,1)*19 ; if ($sum % 89 eq 0) { return $abn_invalid ; } else { $abn_error = 1 ; return $abn_invalid ; } # see https://abr.business.gov.au/Help/AbnFormat }

Replies are listed 'Best First'.
Re: ABN checker
by choroba (Bishop) on Feb 06, 2019 at 10:48 UTC
    To reduce surprise, the function should return true if the number is valid, and false otherwise, which is the other way round.

    There's no need to backslash a space in regular expressions. Moreover, there's no need for a substitution in this case, transliteration does the same job (and is simpler and faster).

    There's a pattern in the computation of the sum which could be expressed by a for loop.

    See my version below:

    sub check_abn { my ($number) = @_; $number =~ tr/ //d; return if 11 != length $number; my $sum = 0; $sum += (2 * $_ - 1) * substr $number, $_, 1 for 1 .. 10; $sum += 10 * (substr($number, 0, 1) - 1); return $sum % 89 == 0 }

    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
      Thanks for your suggestions, especially to reverse the logic and reduce surprise.
        I like the code from choroba, he posted that code while I was still writing mine.

        Some notation comments: Instead of "ChkABN", I would use "isABN". That is a common convention that makes it clear that this is a yes/no question, usually >0 or 0 for return value (any non zero value is "true").

        I would reserve any variable name that starts with a capital letter for a Class.

        I personally like the style that choroba use for naming (all lower case and _ for separation). is_ABN() would be a good name for me.

Re: ABN checker
by hippo (Chancellor) on Feb 06, 2019 at 11:02 UTC
    I'm needing a procedure to check Australian Business Numbers (aka ABN's).

    Might I suggest Business::AU::ABN and the validate_abn function?

      Thanks for pointing me in that direction. I'd tried googling for this module, but should have searched metacpan directly. package Business::AU::TFN will be a handy package too. Thanks for sharing your wisdom.
Re: ABN checker
by Marshall (Abbot) on Feb 06, 2019 at 11:38 UTC
    I guess something like this? I would probably return just a 0 or 1 for a true/false value. Here "True" and "False" just happened so the printout looked nice.
    #!/usr/bin/perl use strict; use warnings; my $x = isABN("51 824 753 556"); print "$x\n"; $x = isABN("51 824 755 556"); print "$x\n"; sub isABN # returns True if ABN, False if not an ABN { my $abn = shift; $abn =~ tr/ //d; #delete spaces return "False" unless (length $abn == 11); my @digits = split '',$abn; $digits[0] -= 1; my @weights = (10,1,3,5,7,9,11,13,15,17,19); my $sum =0; for my $i (0..10) { $sum = $sum + ($digits[$i] * $weights[$i]); } print "sum = $sum\n"; #for debugging... return ($sum % 89 == 0? "True": "False"); } __END__ sum = 534 True sum = 560 False
Re: ABN checker
by Don Coyote (Friar) on Feb 07, 2019 at 17:37 UTC

    Hello bgroper

    I thought it might be useful to construct a separate weighting array, and then apply that as part of the algorithm to the submitted ABN to check. It's a little rough but I am interested to see what the thoughts are.

    #!/usr/bin/perl use v5.20; use strict; use warnings; my $Num = Prepare_Num( q'51 824 753 556' ); my $verified = check_calc($Num); if( $verified == 1){ say "Valid ABN" }else{ say "ABN check has been unsuccessful" } sub check_calc{ my $Numset = shift; my $w_oset = weighting_oset(); --$Numset->[0][0]; # -[[0],[1]] ? print_list($Numset); my $sum; for my $index( 0 .. 10 ){ $sum += $Numset->[$index][0] *= $w_oset->[$index][0]; } print_list($Numset); $sum %89 == 0; } sub Prepare_Num{ my $NumString = shift; say "arg Num: $NumString"; $NumString =~ s/[^0-9]//g; say "s Num: $NumString"; my $count = $NumString =~ tr/0-9/0-9/; say "count: $count"; $count == 11 or die "non-conforming ABN. Please check."; say "tr Num: $NumString"; my $Numset = []; while( $NumString =~ m/([0-9])/g ){ push @$Numset, [$1]; } print_list( $Numset, 1 ); return( $Numset ); } sub weighting_oset{ #my $woset = [[[0],[1]],[10]]; my $w_oset = [[10]]; push @$w_oset, map { $_ %2 == 1 ? [$_] : () } ( 1..19 ); print_oset( $w_oset ); return $w_oset; } sub print_list{ my $Numlist = shift; say "list: ",@$Numlist if @_; # $_[0] == 1; say "list: \[", map("[@$_],", @$Numlist), "\]"; } sub print_oset{ my $Oset = shift; say "oset: ",@$Oset if @_; # $_[0] == 1; say "oset: \{", map("[@$_],", @$Oset), "\}"; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1229460]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2019-10-19 03:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?