File Coverage

blib/lib/App/rdapper.pm

Criterion	Covered	Total	%
statement	238	406	58.6
branch	91	204	44.6
condition	32	81	39.5
subroutine	45	64	70.3
pod	1	38	2.6
total	407	793	51.3

package App::rdapper;
use App::rdapper::l10n;
use Encode qw(decode);
use File::ShareDir qw(:ALL);
use Getopt::Long qw(GetOptionsFromArray :config pass_through);
use JSON;
use List::Util qw(any min max uniq);
use Net::ASN;
use Net::DNS::Domain;
use Net::IDN::PP;
use Net::IP;
use Net::RDAP::EPPStatusMap;
use Net::RDAP 0.41;
use Pod::Usage;
use POSIX qw(setlocale LC_ALL);
use Term::ANSIColor;
use Term::Size;
use Text::Wrap;
use URI;
use constant {
    GETTEXT_DOMAIN  => q{rdapper},
    # see RFC 6350, Section 6.3.1.
    'ADR_STREET'    => 2,
    'ADR_CITY'      => 3,
    'ADR_SP'        => 4,
    'ADR_PC'        => 5,
    'ADR_CC'        => 6,
    'INDENT'        => '  ',
    'IANA_BASE_URL' => 'https://rdap.iana.org/',
};
use locale;
use vars qw($VERSION $LH);
use strict;

$VERSION = '1.24';

$LH = App::rdapper::l10n->get_handle;

$LH->die_for_lookup_failures(1);
$LH->bindtextdomain(GETTEXT_DOMAIN, $ENV{RDAPPER_LOCALE_DIR} || module_dir(__PACKAGE__));
$LH->textdomain(GETTEXT_DOMAIN);

#
# global arg variables
#
my (
    $type, $object, $help, $short, $bypass, $auth, $nopager, $raw, $both,
    $registrar, $nocolor, $reverse, $version, $search, $debug, $registry,
    $strings
);

#
# options spec for Getopt::Long
#
my %opts = (
    'type:s'        => \$type,
    'object:s'      => \$object,
    'help'          => \$help,
    'short'         => \$short,
    'bypass-cache'  => \$bypass,
    'auth:s'        => \$auth,
    'nopager'       => \$nopager, # ignored
    'raw'           => \$raw,
    'both'          => \$both,
    'registrar'     => \$registrar,
    'registry'      => \$registry,
    'nocolor'       => \$nocolor,
    'reverse'       => \$reverse,
    'version'       => \$version,
    'search'        => \$search,
    'debug'         => \$debug,
    'autnum'        => sub { $type = 'autnum' },
    'domain'        => sub { $type = 'domain' },
    'nameserver'    => sub { $type = 'nameserver' },
    'entity'        => sub { $type = 'entity' },
    'ip'            => sub { $type = 'ip' },
    'tld'           => sub { $type = 'tld' },
    'url'           => sub { $type = 'url' },
    'strings'       => \$strings,
);

my $funcs = {
    'ip network' => sub { __PACKAGE__->print_ip(@_) },
    'autnum'     => sub { __PACKAGE__->print_asn(@_) },
    'domain'     => sub { __PACKAGE__->print_domain(@_) },
    'entity'     => sub { __PACKAGE__->print_entity(@_) },
    'nameserver' => sub { __PACKAGE__->print_nameserver(@_) },
    'help'       => sub { 1 }, # help only contains generic properties
};

my $OBJECT_TYPE_DISPLAY_NAMES = {
    'ip network' => _('IP Network'),
    'autnum'     => _('Autonomous System'),
    'domain'     => _('Domain Name'),
    'entity'     => _('Entity'),
    'nameserver' => _('Nameserver'),
    'help'       => _('Help'),
};

my @ROLE_DISPLAY_NAMES_ORDER = qw(registrant administrative technical billing
    abuse registrar reseller sponsor proxy notifications noc);

my %ROLE_DISPLAY_NAMES = (
    'registrant'        => _('Registrant'),
    'technical'         => _('Technical'),
    'administrative'    => _('Administrative'),
    'abuse'             => _('Abuse'),
    'billing'           => _('Billing'),
    'registrar'         => _('Registrar'),
    'reseller'          => _('Reseller'),
    'sponsor'           => _('Sponsor'),
    'proxy'             => _('Proxy'),
    'notifications'     => _('Notifications'),
    'noc'               => _('NOC'),
);

my %EVENT_DISPLAY_NAMES = (
    'registration'                  => _('Registration'),
    'reregistration'                => _('Reregistration'),
    'last changed'                  => _('Last Changed'),
    'expiration'                    => _('Expiration'),
    'deletion'                      => _('Deletion'),
    'reinstantiation'               => _('Reinstantiation'),
    'transfer'                      => _('Transfer'),
    'locked'                        => _('Locked'),
    'unlocked'                      => _('Unlocked'),
    'last update of RDAP database'  => _('Last update of RDAP database'),
    'registrar expiration'          => _('Registrar expiration'),
    'enum validation expiration'    => _('ENUM validation expiration'),
);

my %STATUS_DISPLAY_NAMES = (
    'validated'                     => _('validated'),
    'renew prohibited'              => _('renew prohibited'),
    'update prohibited'             => _('update prohibited'),
    'transfer prohibited'           => _('transfer prohibited'),
    'delete prohibited'             => _('delete prohibited'),
    'proxy'                         => _('proxy'),
    'private'                       => _('private'),
    'removed'                       => _('removed'),
    'obscured'                      => _('obscured'),
    'associated'                    => _('associated'),
    'active'                        => _('active'),
    'inactive'                      => _('inactive'),
    'locked'                        => _('locked'),
    'pending create'                => _('pending create'),
    'pending renew'                 => _('pending renew'),
    'pending transfer'              => _('pending transfer'),
    'pending update'                => _('pending update'),
    'pending delete'                => _('pending delete'),
    'add period'                    => _('add period'),
    'auto renew period'             => _('auto renew period'),
    'client delete prohibited'      => _('client delete prohibited'),
    'client hold'                   => _('client hold'),
    'client renew prohibited'       => _('client renew prohibited'),
    'client transfer prohibited'    => _('client transfer prohibited'),
    'client update prohibited'      => _('client update prohibited'),
    'pending restore'               => _('pending restore'),
    'redemption period'             => _('redemption period'),
    'renew period'                  => _('renew period'),
    'server delete prohibited'      => _('server delete prohibited'),
    'server renew prohibited'       => _('server renew prohibited'),
    'server transfer prohibited'    => _('server transfer prohibited'),
    'server update prohibited'      => _('server update prohibited'),
    'server hold'                   => _('server hold'),
    'transfer period'               => _('transfer period'),
    'administrative'                => _('administrative'),
    'reserved'                      => _('reserved'),
);

my @EVENTS = (
    'registration',
    'reregistration',
    'last changed',
    'expiration',
    'deletion',
    'reinstantiation',
    'transfer',
    'locked',
    'unlocked',
    'last update of RDAP database',
    'registrar expiration',
    'enum validation expiration',
);

my %EVENT_DISPLAY_ORDER;
for (my $i = 0 ; $i < scalar(@EVENTS) ; $i++) {
    $EVENT_DISPLAY_ORDER{$EVENTS[$i]} = $i;
}

my %NOTICE_REMARK_TYPE = (
    'result set truncated due to authorization'         => _('result set truncated due to authorization'),
    'result set truncated due to excessive load'        => _('result set truncated due to excessive load'),
    'result set truncated due to unexplainable reasons' => _('result set truncated due to unexplainable reasons'),
    'object truncated due to authorization'             => _('object truncated due to authorization'),
    'object truncated due to excessive load'            => _('object truncated due to excessive load'),
    'object truncated due to unexplainable reasons'     => _('object truncated due to unexplainable reasons'),
    'object redacted due to authorization'              => _('object redacted due to authorization'),
);

my %VCARD_KIND_DISPLAY_NAME = (
    'individual'    => _('individual'),
    'group'         => _('group'),
    'org'           => _('org'),
    'location'      => _('location'),
    'application'   => _('application'),
    'device'        => _('device'),
);

my @VCARD_DISPLAY_ORDER = qw(SOURCE KIND FN TITLE ROLE ORG ADR GEO EMAIL CONTACT-URI SOCIALPROFILE TEL IMPP URL CATEGORIES NOTE);
my %VCARD_NODE_NAMES = (
    ADR             => _('Address'),
    CATEGORIES      => _('Categories'),
    'CONTACT-URI'   => _('Contact Link'),
    EMAIL           => _('Email'),
    FN              => _('Name'),
    GEO             => _('Location'),
    IMPP            => _('Messaging'),
    KIND            => _('Kind'),
    NOTE            => _('Note'),
    ORG             => _('Organization'),
    ROLE            => _('Role'),
    SOCIALPROFILE   => _('Profile'),
    SOURCE          => _('Source'),
    TEL             => _('Phone'),
    TITLE           => _('Title'),
    URL             => _('Website'),
);

my %PUBLIC_ID_DISPLAY_NAME = (
    'IANA Registrar ID' => _('IANA Registrar ID'),
);

my @ADR_DISPLAY_ORDER = (ADR_STREET, ADR_CITY, ADR_SP, ADR_PC, ADR_CC);
my %ADR_DISPLAY_NAMES = (
    &ADR_STREET => _('Street'),
    &ADR_CITY   => _('City'),
    &ADR_SP     => _('State/Province'),
    &ADR_PC     => _('Postal Code'),
    &ADR_CC     => _('Country'),
);

my $json = JSON->new->utf8->canonical->pretty->convert_blessed;

my $rdap;

my $out = \*STDOUT;
my $err = \*STDERR;

$out->binmode(':utf8');
$err->binmode(':utf8');

$Text::Wrap::columns    = max((Term::Size::chars)[0], 75);
$Text::Wrap::huge       = 'overflow';

sub main {
    my $package = shift;

    my $rcfile = sprintf(q{%s/.rdapper}, $ENV{HOME});
    if (-e $rcfile && open(my $fh, $rcfile)) {
        push(@_, map { chomp ; $_ } $fh->getlines);
        $fh->close;
    }

    GetOptionsFromArray(\@_, %opts) || $package->show_usage;

    #
    # this undocumented behaviour is used to export all the translateable
    # strings in this file.
    #
    export_strings() if ($strings);

    $ENV{NET_RDAP_UA_DEBUG} = 1 if ($debug);

    my $lang = $LH->language_tag || q{en};
    $lang =~ s/_/-/g;

    $rdap = Net::RDAP->new(
        'use_cache'         => !$bypass,
        'cache_ttl'         => 300,
        'accept_language'   => $lang,
    );

    $package->show_version if ($version);

    if ($registry && $registrar) {
        $package->error(_("cannot specify both --registry and --registrar, use one or the other."));

    } elsif ($registry && $both) {
        $package->error(_("cannot specify both --registry and --both, use one or the other."));

    }

    $registrar ||= $both;

    if (!$registry && !$both) {
        $registrar = 1;
    }

    $object = shift(@_) if (!$object);

    $package->show_usage if ($help || length($object) < 1);

    if (!$type) {
        if ($object =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/)              { $type = 'ip'      }
        elsif ($object =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\/\d{1,2}$/)  { $type = 'ip'      }
        elsif ($object =~ /^[0-9a-f:]+:[0-9a-f:]*$/i)                       { $type = 'ip'      }
        elsif ($object =~ /^[0-9a-f:]+:[0-9a-f:]*\/\d{1,3}$/i)              { $type = 'ip'      }
        elsif ($object =~ /^asn?\d+$/i)                                     { $type = 'autnum'  }
        elsif ($object =~ /^(file|https)?:\/\//)                            { $type = 'url'     }
        elsif ($object =~ /^([a-z]{2,}|xn--[a-z0-9\-]+)$/i)                 { $type = 'tld'     }
        else                                                                { $type = 'domain'  }
    }

    my %args;
    ($args{'user'}, $args{'pass'}) = split(/:/, $auth, 2) if ($auth);

    if ($search) {
        $package->search($rdap, $object, $type, %args);

    } else {
        $package->lookup($rdap, $object, $type, %args);

    }
}

sub lookup {
    my ($package, $rdap, $object, $type, %args) = @_;

    my $response;

    if ('ip' eq $type) {
        my $ip = Net::IP->new($object);

        $package->error(_("invalid IP address '[_1]'", $object)) unless ($ip);

        $response = $rdap->ip($ip, %args);

        $response = $rdap->fetch($response->domain) if ($reverse);

    } elsif ('autnum' eq $type) {
        my $asn = $object;
        $asn =~ s/^asn?//ig;

        $response = $rdap->autnum(Net::ASN->new($asn), %args);

    } elsif ('domain' eq $type) {
        $response = $rdap->domain(Net::DNS::Domain->new($package->encode_idn($object)), %args);

    } elsif ('nameserver' eq $type) {
        my $url = Net::RDAP::Registry->get_url(Net::DNS::Domain->new($package->encode_idn($object)));

        #
        # munge path
        #
        my $path = $url->path;
        $path =~ s!/domain/!/nameserver/!;
        $url->path($path);

        $response = $rdap->fetch($url, %args);

    } elsif ('entity' eq $type) {
        $response = $rdap->entity($object, %args);

    } elsif ('tld' eq $type) {
        $response = $rdap->fetch(URI->new(IANA_BASE_URL.'domain/'.$package->encode_idn($object)), %args);

    } elsif ('url' eq $type) {
        my $uri = URI->new($object);

        #
        # if the path ends with /help then we assume then it's a help query
        #
        $args{'class_override'} = 'help' if ('help' eq lc(($uri->path_segments)[-1]));

        $response = $rdap->fetch($uri, %args);

    } else {
        $package->error(_("Unable to handle type '[_1]'", $type));

    }

    $package->display($response, 0);
}

sub show_usage {
    my $package = shift;

    pod2usage(
        '-input'    => __FILE__,
        '-verbose'  => 99,
        '-sections' => [qw(SYNOPSIS OPTIONS)],
    );
}

sub show_version {
    my $package = shift;
    $out->say(sprintf('%s v%s', $package, $VERSION));
    exit;
}

sub search {
    my ($package, $rdap, $object, $type, %args) = @_;

    if ('domain' eq $type) {
        $package->domain_search($rdap, $object, %args);

    } else {
        $package->error(_("current unable to do searches for '[_1]' objects.", $type));

    }
}

sub domain_search {
    my ($package, $rdap, $query, %args) = @_;

    my @labels = grep { length > 0 } split(/\./, lc($query), 2);

    my $prefix = shift(@labels);
    my $suffix = shift(@labels) || '*';

    my $servers = {};
    my $zones = {};

    foreach my $service (Net::RDAP::Registry->load_registry(Net::RDAP::Registry::DNS_URL)->services) {
        foreach my $zone ($service->registries) {
            my $url = Net::RDAP::Registry->get_best_url($service->urls);

            if (!exists($servers->{$url->as_string})) {
                $servers->{$url->as_string} = Net::RDAP::Service->new($url);
            }

            $zones->{lc($zone)} = $url->as_string;
        }
    }

    my @zones = sort(keys(%{$zones}));
    @zones = grep { lc($suffix) eq $_ || $suffix =~ /\.$_/i } @zones if ($suffix ne '*');

    foreach my $zone (@zones) {
        my $server = $servers->{$zones->{$zone}};
        my $result = $server->domains(name => $prefix);

        if ($result->isa('Net::RDAP::Error')) {
            $package->warning(sprintf('%s.%s: %s %s', $prefix, $zone, $result->errorCode, $result->title));

        } elsif ($result->isa('Net::RDAP::SearchResult')) {
            $package->display_domain_search_results($result);

        }
    }
}

sub display_domain_search_results {
    my ($package, $result) = @_;

    foreach my $domain ($result->domains) {
        $out->say($domain->name->name);
    }
}

sub display_nameserver_search_results {
    my ($package, $result) = @_;

    foreach my $nameserver ($result->nameservers) {
        $out->say($nameserver->name->name);
    }
}

sub display_entity_search_results {
    my ($package, $result) = @_;

    foreach my $entity ($result->entities) {
        $out->say($entity->handle);
    }
}

sub display_search {
    my ($package, $result) = @_;

    $package->display_domain_search_results($result)        if (exists($result->{domainSearchResults}));
    $package->display_nameserver_search_results($result)    if (exists($result->{nameserverSearchResults}));
    $package->display_entity_search_results($result)        if (exists($result->{entitySearchResults}));
}

sub display {
    my ($package, $object, $indent, $nofatal) = @_;

    if ($object->isa('Net::RDAP::Error')) {
        if ($nofatal) {
            $package->warning('%03u (%s)', $object->errorCode, $object->title);

        } else {
            $package->error('%03u (%s)', $object->errorCode, $object->title);

        }

    } else {
        my $link = (grep { 'related' eq $_->rel && $_->is_rdap } $object->links)[0];

        if ($registrar) {
            # avoid recursing infinitely
            $registrar = undef;

            if (!$link) {
                $package->display($object, $indent);

            } else {
                my $result = $rdap->fetch($link);

                if ($result->isa('Net::RDAP::Error')) {
                    $package->display($result, $indent, 1);

                    $package->warning(_('Unable to retrieve registrar record, displaying the registry record...'));
                    $package->display($object, $indent);

                } else {
                    $package->display($object, $indent, 1) if ($both);

                    $package->display($result, $indent);

                }
            }

        } else {
            if ($raw) {
                $out->print($json->encode($object));

            } elsif ($object->isa('Net::RDAP::SearchResult')) {
                $package->display_search($object);

            } else {
                $package->display_object($object, $indent);

            }
        }
    }
}

sub display_object {
    my ($package, $object, $indent) = @_;

    $package->error(_("object does not include the 'objectClassName' properties")) unless ($object->class);
    $package->error(_("unknown object type '[_1]'", $object->class)) unless ($funcs->{$object->class});

    #
    # generic properties
    #
    $package->print_kv(_('Object type'), $OBJECT_TYPE_DISPLAY_NAMES->{$object->class}, $indent) if ($indent < 1);
    $package->print_kv(_('URL'), u($object->self->href), $indent) if ($indent < 1 && $object->self);

    if ($object->can('name')) {
        my $name = $object->name;
        $name = $name->name if ($name->can('name'));

        my $xname = $object->can('unicodeName') ? $object->unicodeName || $name : $name;

        if ($xname ne $name) {
            $package->print_kv(_('Name'), sprintf('%s (%s)', uc($xname), uc($name)));

        } else {
            $package->print_kv(_('Name'), uc($name));

        }
    }

    #
    # object-specific properties
    #
    $funcs->{$object->class}->($object, $indent);

    #
    # more generic properties
    #
    $package->print_events($object, $indent);
    $package->print_status($object, $indent, ('domain' eq $object->class));

    $package->print_entities($object, $indent);

    #
    # links, remarks, notices and redactions, unless --short has been passed
    #
    if (!$short) {
        foreach my $link (grep { 'self' ne $_->rel } $object->links) {
            $package->print_link($link, $indent);
        }

        foreach my $remark ($object->remarks) {
            $package->print_remark_or_notice($remark, $indent);
        }

        foreach my $notice ($object->notices) {
            $package->print_remark_or_notice($notice, $indent);
        }

        my @fields = $object->redactions;
        if (scalar(@fields) > 0) {
            $package->print_kv(_('Redacted Fields'), '', $indent);
            foreach my $field (@fields) {
                $out->print(wrap(
                    (INDENT x ($indent + 1)),
                    (INDENT x ($indent + 2)),
                    sprintf("%s %s\n", b('*'), _("[_1] (reason: [_2])", $field->name, $field->reason))
                ));
            }
        }
    }

    $out->print("\n") if ($indent < 1);
}

sub print_ip {
    my ($package, $ip, $indent) = @_;

    $package->print_kv(_('Handle'),     $ip->handle, $indent)               if ($ip->handle);
    $package->print_kv(_('Version'),    $ip->version, $indent)              if ($ip->version);
    $package->print_kv(_('Domain'),     u($ip->domain->as_string), $indent) if ($ip->domain);
    $package->print_kv(_('Type'),       $ip->type, $indent)                 if ($ip->type);
    $package->print_kv(_('Country'),    $ip->country, $indent)              if ($ip->country);
    $package->print_kv(_('Parent'),     $ip->parentHandle, $indent)         if ($ip->parentHandle);
    $package->print_kv(_('Range'),      $ip->range->prefix, $indent)        if ($ip->range);

    foreach my $cidr ($ip->cidrs) {
        $package->print_kv(_('CIDR'), $cidr->prefix, $indent);
    }
}

sub print_asn {
    my ($package, $asn, $indent) = @_;

    $package->print_kv(_('Handle'), $asn->handle, $indent) if ($asn->handle);
    $package->print_kv(_('Range'),  sprintf('%u - %u', $asn->start, $asn->end), $indent) if ($asn->start > 0 && $asn->end > 0 && $asn->end > $asn->start);
    $package->print_kv(_('Type'),   $asn->type, $indent) if ($asn->type);
}

sub print_domain {
    my ($package, $domain, $indent) = @_;

    $package->print_kv(_('Handle'), $domain->handle, $indent) if ($domain->handle);

    foreach my $ns (sort { lc($a->name->name) cmp lc($b->name->name) } $domain->nameservers) {
        if ($short) {
            $package->print_kv(_('Nameserver'), uc($ns->name->name) . ' ' . join(' ', map { $_->short } $ns->addresses), $indent);

        } else {
            $package->print_kv(_('Nameserver'), uc($ns->name->name), $indent);
            $package->print_nameserver($ns, 1+$indent);
        }
    }

    foreach my $ds ($domain->ds) {
        $package->print_kv(_('DS Record'), $ds->plain, $indent);
    }

    foreach my $key ($domain->keys) {
        $package->print_kv(_('DNSKEY Record'), $key->plain, $indent);
    }

    $package->display_artRecord($domain->{'artRecord_record'}, $indent) if ($domain->{'artRecord_record'});
    $package->display_platform_nameservers($domain->{'platformNS_nameservers'}, $indent) if ($domain->{'platformNS_nameservers'});

    $package->print_kv(_('Registration Type'), $domain->{'regType_regType'}) if ($domain->{'regType_regType'});

    my @types = $domain->dns_ttl_types;
    $package->display_ttl_values($domain, $indent) if (scalar(@types) > 0);
}

sub display_artRecord {
    my ($package, $records, $indent) = @_;

    $package->print_kv(_('Art Record'), undef, $indent);

    foreach my $record (@{$records}) {
        $package->print_kv($record->{'name'}, $record->{'value'}, 1+$indent);
    }
}

sub display_platform_nameservers {
    my ($package, $nameservers, $indent) = @_;

    foreach my $ns (@{$nameservers}) {
        $package->print_kv(_('Platform Nameserver'), uc(Net::RDAP::Object::Nameserver->new($ns)->name->name), $indent);
    }
}

sub print_entity {
    my ($package, $entity, $indent) = @_;

    $package->print_kv(_('Handle'), $entity->handle, $indent) if ($entity->handle && $indent < 1);

    foreach my $id ($entity->ids) {
        $package->print_kv($PUBLIC_ID_DISPLAY_NAME{$id->type} || $id->type, $id->identifier, $indent);
    }

    my $jcard = $entity->jcard;
    if ($jcard) {
        $package->print_jcard($jcard, $indent);
    }
}

sub print_jcard {
    my ($package, $jcard, $indent) = @_;

    foreach my $ptype (@VCARD_DISPLAY_ORDER) {
        foreach my $property (grep { $_->value } $jcard->properties($ptype)) {
            $package->print_jcard_property($property, $indent);
        }
    }
}

sub print_jcard_property {
    my ($package, $property, $indent) = @_;

    if ('ADR' eq uc($property->type)) {
        $package->print_jcard_adr($property, $indent);

    } else {
        my $label = $VCARD_NODE_NAMES{uc($property->type)} || ucfirst(lc($property->type));
        my $value = $property->value;

        if ('KIND' eq uc($property->type)) {
            $value = $VCARD_KIND_DISPLAY_NAME{$value} || $value;

        } elsif ('TEL' eq uc($property->type)) {
            my $types = $property->param('type');
            $types = [ $types ] if (q{ARRAY} ne ref($types));

            if (any { 'fax' eq lc($_) } @{$types}) {
                $label = _('Fax');

            } else {
                $label = _('Phone');

            }
        }

        $package->print_kv(
            $label,
            $property->may_be_uri ? u($value) : $value,
            $indent
        );
    }
}

sub print_jcard_adr {
    my ($package, $property, $indent) = @_;

    $package->print_kv(_('Address'), '', $indent);

    if ($property->param('label')) {
        $out->print(wrap(
            INDENT x ($indent + 1),
            INDENT x ($indent + 1),
            $property->param('label'),
        )."\n");

    } else {
        foreach my $i (@ADR_DISPLAY_ORDER) {
            if ($property->value->[$i]) {
                if ('ARRAY' eq ref($property->value->[$i])) {
                    foreach my $v (grep { $_ } @{$property->value->[$i]}) {
                        $package->print_kv($ADR_DISPLAY_NAMES{$i}, $v, $indent+1);
                    }

                } else {
                    $package->print_kv($ADR_DISPLAY_NAMES{$i}, $property->value->[$i], $indent+1);

                }
            }
        }
    }

    if ($property->param('cc')) {
        $package->print_kv(_('Country'), $property->param('cc'), $indent+1);
    }
}

sub print_nameserver {
    my ($package, $nameserver, $indent) = @_;

    $package->print_kv(_('Handle'), $nameserver->handle, $indent) if ($nameserver->handle);

    foreach my $ip ($nameserver->addresses) {
        $package->print_kv(_('IP Address'), $ip->short, $indent);
    }

    my @types = $nameserver->dns_ttl_types;
    $package->display_ttl_values($nameserver, $indent) if (scalar(@types) > 0);
}

sub print_events {
    my ($package, $object, $indent) = @_;

    foreach my $event (sort { $EVENT_DISPLAY_ORDER{$a->action} - $EVENT_DISPLAY_ORDER{$b->action} } $object->events) {
        my $action = $EVENT_DISPLAY_NAMES{$event->action} || ucfirst($event->action);

        if ($event->actor) {
            $package->print_kv($action, _('[_1] (by [_2])', scalar($event->date), $event->actor), $indent);

        } else {
            $package->print_kv($action, scalar($event->date).$event->date_tz, $indent);

        }
    }
}

sub print_status {
    my ($package, $object, $indent, $is_domain) = @_;

    foreach my $status ($object->status) {

        my $epp = rdap2epp($status);
        if ($epp && $is_domain && !$short) {
            my $friendly = $STATUS_DISPLAY_NAMES{$status} || $status;
            if ($friendly ne $status) {
                $package->print_kv(_('Status'), _('[_1] ([_2], EPP: [_3], [_4])', $friendly, $status, $epp, u(sprintf('https://icann.org/epp#%s', $epp))), $indent);

            } else {
                $package->print_kv(_('Status'), _('[_1] (EPP: [_2], [_3])', $status, $epp, u(sprintf('https://icann.org/epp#%s', $epp))), $indent);

            }

        } else {
            $package->print_kv(_('Status'), $status, $indent);

        }
    }
}

sub print_entities {
    my ($package, $object, $indent) = @_;

    my @entities = $object->entities;

    my %seen;
    foreach my $role (@ROLE_DISPLAY_NAMES_ORDER) {
        for (my $i = 0 ; $i < scalar(@entities) ; $i++) {
            next if ($seen{$i});

            my $entity = $entities[$i];
            if (any { $role eq $_ } $entity->roles) {
                $seen{$i} = 1;

                my $rstring = join(', ', map { _('[_1] Contact', $ROLE_DISPLAY_NAMES{$_} || ucfirst($_)) } $entity->roles);

                if ($entity->handle && 'not applicable' ne $entity->handle && 'HANDLE REDACTED FOR PRIVACY' ne $entity->handle) {
                    $package->print_kv($rstring, $entity->handle, $indent);

                } else {
                    $package->print_kv($rstring, undef, $indent);

                }

                eval {
                    $package->display($entity, 1+$indent, 1);
                };
            }
        }
    }
}

sub print_remark_or_notice {
    my ($package, $thing, $indent) = @_;

    my $type = ($thing->isa('Net::RDAP::Notice') ? _('Notice') : _('Remark'));

    if (1 == scalar($thing->description)) {
        $package->print_kv($thing->title || $type, ($thing->description)[0], $indent);

    } else {
        $package->print_kv($thing->title || $NOTICE_REMARK_TYPE{$thing->type} || $type, , '', $indent);

        $out->print(fill(
            (INDENT x (1+$indent)),
            (INDENT x (1+$indent)),
            $thing->description
        )."\n");
    }

    foreach my $link ($thing->links) {
        $package->print_link($link, 1+$indent);
    }
}

sub print_link {
    my ($package, $link, $indent) = @_;

    $package->print_kv(
        $link->title || ('related' eq $link->rel ? 'Link' : ucfirst($link->rel)) || 'Link',
        u($link->href->as_string),
        $indent,
    );
}

sub display_ttl_values {
    my ($package, $object, $indent) = @_;

    $package->print_kv(_('DNS TTL Values'), '', $indent);

    foreach my $type ($object->dns_ttl_types) {
        $package->print_kv($type, _('[_1]s', $object->dns_ttl($type)), 1+$indent);
    }

    foreach my $remark ($object->dns_ttl_remarks) {
        $package->print_remark_or_notice($remark, 1+$indent);
    }
}

sub print_kv {
    my ($package, $name, $value, $indent) = @_;

    $out->print(wrap(
        (INDENT x $indent),
        (INDENT x ($indent + 1)),
        sprintf("%s %s\n", b($name.':'), $value),
    ));
}

sub debug {
    my ($package, $fmt, @params) = @_;
    if ($debug) {
        my $str = sprintf(_("Debug: [_1]", $fmt), @params);
        $err->say(colourise([qw(magenta)], $str));
    }
}

sub info {
    my ($package, $fmt, @params) = @_;
    my $str = sprintf(_("Info: [_1]", $fmt), @params);
    $err->say(colourise([qw(cyan)], $str));
}

sub warning {
    my ($package, $fmt, @params) = @_;
    my $str = sprintf(_("Warning: [_1]", $fmt), @params);
    $err->say(colourise([qw(yellow)], $str));
}

sub error {
    my ($package, $fmt, @params) = @_;
    my $str = sprintf(_("Error: [_1]", $fmt), @params);
    $err->say(colourise([qw(red)], $str));
    exit 1;
}

sub colourise {
    my ($cref, $str) = @_;

    if (-t $out && !$nocolor) {
        return colored($cref, $str);

    } else {
        return $str;

    }
}

sub u { colourise([qw(underline)], shift) }
sub b { colourise([qw(bold)], shift) }
sub _ { decode($LH->encoding, $LH->maketext(@_)) }

#
# this function uses PPI to parse this file, extract the messages passed to _()
# and prints a .po file on STDOUT.
#
sub export_strings {
    eval {
        require PPI;

        my $doc = PPI::Document->new(__FILE__);
        $doc->prune(q{PPI::Token::Comment});
        $doc->prune(q{PPI::Token::Whitespace});

        my @msgs;

        my @nodes = @{$doc->find(sub { 1 })};
        for (my $i = 0 ; $i < scalar(@nodes) ; $i++) {
            my $node = $nodes[$i];

            if ($node->isa(q{PPI::Token::Magic}) && q{_} eq $node->content) {
                my $next = $nodes[$i+1];

                if ($next->isa(q{PPI::Structure::List})) {
                    my $msg = ($next->tokens)[1];

                    if (!$msg->isa(q{PPI::Token::Quote})) {
                        die(sprintf(
                            "%s: first argument to _() must be a string literal",
                            $msg->content,
                        ));
                    }

                    push(@msgs, $msg->string);
                }
            }
        }

        foreach my $msg (uniq(@msgs)) {
            printf("msgid \"%s\"\nmsgstr \"\"\n\n", $msg);
        }
    };

    exit;
}

sub encode_idn {
    my ($package, $name) = @_;
    return Net::IDN::PP->encode($name);
}

1;

__END__