How to trim URL to root domain?

Hi @JMichaelTX and @AkshayHallur,

since I already started with the Perl script yesterday, I couldn't resist to complete it :wink:

Advantages over the other solution:

  • No wonky regex used. The domain root is determined with the help of the Current Effective TLD List. So, the script has no problems with fancy stuff like www.cs.tut.fi or kartolo.sby.datautama.net.id.
  • The script is auto-choosing the correct Whois server for the domain.
  • Since different Whois servers are using different output formats, server-specific parsers are used to extract the Domain Creation Date.
  • Not really important, but the age is calculated properly, not based on an average month length.

Output example:


Domain Date and Age (Perl Variant).kmmacros (4.5 KB)


The content of the script:

#!/usr/bin/env perl

use 5.010;
use strict;
use warnings;

use Domain::PublicSuffix;
use Net::Domain::ExpireDate;
use Date::Calc qw(Today Delta_Days N_Delta_YMD);

# Getting the input from KM
my $url_input = qx/osascript -e 'tell application "Keyboard Maestro Engine" to getvariable "ddaURL"'/;
chomp($url_input);

# Getting domain (root)
my $suffix = Domain::PublicSuffix->new();
my $domain = $suffix->get_root_domain($url_input);

# Get creation and expiry date of domain
(my $creation_str, my $expiry_str) = domain_dates($domain, '%Y-%m-%d');

# Date calculations
my $gmt = 1;
(my $year_creation, my $month_creation, my $day_creation) = split('-', $creation_str);
(my $year_now, my $month_now, my $day_now) = Today([$gmt]);

my $delta_days_total = Delta_Days($year_creation, $month_creation, $day_creation, $year_now, $month_now, $day_now);

(my $delta_years, my $delta_months, my $delta_days) = N_Delta_YMD($year_creation, $month_creation, $day_creation, $year_now,  $month_now, $day_now);

# Output
my $year_label = $delta_years == 1 ? ' year, ' : ' years, ';
my $month_label = $delta_months == 1 ? ' month, ' : ' months, ';
my $day_label = $delta_days == 1 ? ' day' : ' days';

say 'Domain:        ' . $domain;
say 'Creation date: ' . $creation_str;
say 'Expiry date:   ' . $expiry_str;
say 'Age:           ' . $delta_years . $year_label . $delta_months . $month_label . $delta_days . $day_label;
say 'Age in days:   ' . $delta_days_total;

__END__

=begin comment

For best results:
Download the most recent TLD names list from 
http://mxr.mozilla.org/mozilla-central/source/netwerk/dns/effective_tld_names.dat?raw=1
and save it @ /usr/local/effective_tld_names.dat

=end comment


Update (2017-09-11):

Output: Correct singular forms now ("1 month", not "1 months", etc.)

1 Like