view release on metacpan or  search on metacpan

lib/App/rdapper.pm  view on Meta::CPAN

        }

    } 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);