File Coverage

blib/lib/No/OrgNr.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	18	18	100.0
condition			n/a
subroutine	11	11	100.0
pod	4	4	100.0
total	90	90	100.0

package No::OrgNr;

use utf8;
use 5.014;
use warnings;
use open qw/:encoding(UTF-8) :std/;

use Net::Whois::Norid;

$Net::Whois::Raw::CHECK_FAIL = 1;
$Net::Whois::Raw::OMIT_MSG   = 1;

use version; our $VERSION = qv('0.9.2');

use parent qw/Exporter/;
our @EXPORT_OK = qw/all domain2orgnr num_domains orgnr_ok orgnr2domains/;
our %EXPORT_TAGS = ( 'all' => [qw/domain2orgnr num_domains orgnr_ok orgnr2domains/] );

sub domain2orgnr {
    my $domain = shift or return;

    if ( $domain !~ / [.] no \z /x ) {
        return;
    }

    return Net::Whois::Norid->new($domain)->id_number;
}

sub num_domains {
    my $orgnr = shift;

    my @domains = orgnr2domains($orgnr);

    return scalar @domains;
}

sub orgnr2domains {
    my $orgnr = shift;

    my @domains;

    if ( !orgnr_ok($orgnr) ) {
        return @domains;
    }

    $orgnr =~ s/ \s //gx;

    my $whois        = Net::Whois::Norid->new($orgnr);
    my $norid_handle = $whois->norid_handle;

    if ( !defined $norid_handle ) {
        return @domains;
    }

    for my $nh ( split / \n /x, $norid_handle ) {
        my $nhobj = Net::Whois::Norid->new($nh);

        for my $domain ( split / /, $nhobj->domains ) {
            push @domains, $domain;
        }
    }

    return ( sort @domains );
}

sub orgnr_ok {
    my $orgnr = shift or return 0;

    $orgnr =~ s/ \s //gx;

    # Valid numbers start on 8 or 9
    if ( $orgnr !~ /\A [89] \d{8} \z/ax ) {
        return 0;
    }

    my @d = split //, $orgnr;
    my $w = [ 3, 2, 7, 6, 5, 4, 3, 2 ];
    my $sum = 0;
    for my $i ( 0 .. 7 ) {
        $sum += $d[$i] * $w->[$i];
    }

    my $rem = $sum % 11;
    my $control_digit = ( $rem == 0 ? 0 : 11 - $rem );

    # Invalid number if control digit is 10
    if ( $control_digit == 10 ) {
        return 0;
    }

    if ( $control_digit != $d[8] ) {
        return 0;
    }

    return $d[0] . $d[1] . $d[2] . ' ' . $d[3] . $d[4] . $d[5] . ' ' . $d[6] . $d[7] . $d[8];
}

1;

__END__