# PODNAME: Domain::Details
# ABSTRACT: Domain class with DNS/SSL/WHOIS fields

use v5.36;
use autouse 'Carp' => qw( carp croak );
use autouse 'Data::Printer' => qw( p );
use Object::Pad 0.78 ':experimental(init_expr)';

package Domain::Details;
# Without, PAUSE: No or no indexable package statements could be found in the distro

# @formatter:off
class Domain::Details :strict( params ) {
# @formatter:on

  use experimental qw( try );
  use Syntax::Keyword::Match;
  use Net::Domain::ExpireDate; # Function: expire_date
  use Domain::PublicSuffix;    # Method: get_root_domain
  use POSIX;                   # Functions: setlocale, LC_ALL
  use Net::SSL::ExpireDate;
  use Net::DNS;
  use Geo::IP;
  use Term::ANSIColor qw( colorstrip );
  use Clipboard; # Class method: copy_to_all_selections

  # @formatter:off

  field $domain :param :reader;


  field $description :param :accessor = undef;


  method $whois_expiration ( $format //= '%B %d, %Y' ) {
    my $publicsuffix = Domain::PublicSuffix -> new;
    setlocale( LC_ALL , 'en_US.UTF-8' );
    return expire_date( $publicsuffix -> get_root_domain( $domain ) , $format ); # domain without the www. prefix
  }
  method $ssl_expiration ( $format //=  "%s %s, %s" ) {
    my $ssl = Net::SSL::ExpireDate -> new( https => $domain );
    try {
      return sprintf $format ,
        $ssl -> expire_date -> month_name ,
        $ssl -> expire_date -> day ,
        $ssl -> expire_date -> year;
    }
    catch( $message ) { undef }
  }
  method $ssl_issue ( $format //=  "%s %s, %s" ) {
    my $ssl = Net::SSL::ExpireDate -> new( https => $domain );
    try {
      return sprintf $format ,
        $ssl -> begin_date -> month_name ,
        $ssl -> begin_date -> day ,
        $ssl -> begin_date -> year;
    }
    catch( $message ) { undef }
  }
  method $ssl_expires_soon ($format //= '14 days' ) {
    my $ssl = Net::SSL::ExpireDate -> new( https => $domain );
    try {
      $ssl -> is_expired( $format );
    }
  catch ( $message ) { undef }

  }

  field $whois_expiration :reader { $self -> $whois_expiration };


  field $ssl_expiration :reader { $self -> $ssl_expiration };



  field $ssl_issue :reader { $self -> $ssl_issue };



  field $ssl_expires_soon :reader { $self -> $ssl_expires_soon };


  method dns ( ) {
  # @formatter:on
    my $resolver = Net::DNS::Resolver -> new;
    my $geo = Geo::IP -> open( '/usr/share/GeoIP/GeoIP.dat' );
    # Set path explicitly because Perlbrew 5.36 on Debian fails to open for searching in /usr/local when Geo::IP is being installed with "cpan"
    # Installing the Debian package libgeo-ip-perl probably fixes that

    my ( $cname , $ptr );

    my $a = $resolver -> query( $domain , 'A' );
    my @a = $a -> answer if defined $a;

    my $mx = $resolver -> query( $domain , 'MX' );
    my @mx = $mx -> answer if defined $mx;

    my $ns = $resolver -> query( $domain , 'NS' );
    my @ns = $ns -> answer if defined $ns;

    my $txt = $resolver -> query( $domain , 'TXT' );
    my @txt = $txt -> answer if defined $txt;

    my $soa = $resolver -> query( $domain , 'SOA' );
    my @soa = $soa -> answer if defined $soa;

    my $answer;

    my %dns = (
      a     => [] ,
      cname => '' ,
      ptr   => [] ,
      mx    => [] ,
      ns    => [] ,
      txt   => [] ,
    ); # to push individual record values here

    for my $record ( @a , @mx , @ns , @txt , @soa ) {
      match( $record -> type : eq )
      {
        case( 'A' )
        {
          $answer .= sprintf( "A:\t%s (%s)\n" , $record -> address , $geo -> country_code_by_addr( $record -> address ));
          push( $dns{a} -> @* , $record -> address );
          $ptr = $resolver -> query( $record -> address , 'PTR' ); # Net::DNS::Packet
          if ( $ptr ) {
            my @ptr = $ptr -> answer; # [ Net::DNS:RR, ... ]
            $answer .= Term::ANSIColor::colored( [ 'bright_cyan' ] , sprintf( "P:\t%s (%s)\n" , $ptr[0] -> ptrdname , $geo -> country_code_by_name( $ptr[0] -> ptrdname )));
            # eq. rdatastr (undocumented)
            push( $dns{ptr} -> @* , $ptr[0] -> ptrdname );
          }
        }
        case( 'CNAME' )
        {
          # fetched by A, for instance
          $cname = Term::ANSIColor::colored( [ 'bright_magenta' ] , sprintf( "C:\t%s (%s)\n" , $record -> cname , $geo -> country_code_by_name( $record -> cname )));
          # 4 - 5 times (seemingly by A)
          $dns{cname} = $record -> cname;
        }
        case( 'MX' )
        {
          $answer .= Term::ANSIColor::colored( [ 'bright_yellow' ] , sprintf( "M:\t%s (%s)\n" , $record -> exchange , $geo -> country_code_by_name( $record -> exchange )));
          push( $dns{mx} -> @* , $record -> exchange );
        }
        case( 'NS' )
        {
          $answer .= Term::ANSIColor::colored( [ 'bright_green' ] , sprintf( "N:\t%s (%s)\n" , $record -> nsdname , $geo -> country_code_by_name( $record -> nsdname )));
          push $dns{ns} -> @* , $record -> nsdname;
        }
        case( 'TXT' )
        {
          $answer .= Term::ANSIColor::colored( [ 'bright_white' ] , sprintf( "T:\t%s\n" , $record -> txtdata ));
          push $dns{txt} -> @* , $record -> txtdata;
        }
        case( 'SOA' )
        { # fetched by A, for instance
          $answer .= Term::ANSIColor::colored(
            [ 'bright_red' ] ,
            sprintf( "S:\t%s %s\n" ,
              $record -> mname ,
              $record -> rname
            )
          );
        }
      }

    }

    $answer = $answer . $cname if defined $cname;
    return $answer;
  }


  # @formatter:off
  method summary () {
  # @formatter:on
    my $summary = <<~ "SUMMARY";
    SSL Expiration   : $ssl_expiration @{[$ssl_expires_soon ? '(Expires Soon)' : '' ]}
    SSL Issue        : $ssl_issue
    WHOIS Expiration : $whois_expiration

    DNS              :

    @{[$self->dns]}
    SUMMARY
    say $summary;
    Clipboard -> copy_to_all_selections( colorstrip $summary );
  }
}

__END__

=pod

=encoding UTF-8

=head1 NAME

Domain::Details - Domain class with DNS/SSL/WHOIS fields

=head1 VERSION

version 0.230320

=head1 METHODS

=head2 domain

Return the current domain as created with the C<new> constructor

=head2 description

Return or set an optional description (comment) on the domain object

=head2 whois_expiration

Returns domain's expiration date using the L<Net::ExpireDate> module's C<expire_date> function

Derives the root domain using L<Domain::PublicSuffix> class' C<get_root_domain> method

Accepts optional argument to specify the format the date is returned in

=head2 ssl_expiration

Return the SSL expiration date using L<Net::SSL::ExpireDate> class' C<expire_date> constructor returning a L<DateTime> object

Accepts an argument to loosely set the date format as Year, Month, Day in C<sprintf> syntax

=head2 ssl_issue

Return the SSL issue date using L<Net::SSL::ExpireDate> class' C<begin_date> constructor returning a L<DateTime> object

Accepts an argument to loosely set the date format as Year, Month, Day in C<sprintf> syntax

=head2 ssl_expires_soon

Return a boolean indicating if the SSL expires within the time specified

Defaults to 14 days, ie. 2 weeks which is a normal renewal date

=head2 dns

L<Net::DNS> records (A, CNAME, MX, NS, TXT, and SOA) with with L<Geo::IP>

Uses L<Syntax::Keyword::Match> to topicalize C<$record -> type>

=head2 summary

Output summary, and copy it into the clipboard stripping colors with L<C<colorstrip>|Term::ANSIColor/colorstrip(STRING[, STRING ...])>

=head1 AUTHOR

Elvin Aslanov <rwp.primary@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023 by Elvin Aslanov.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
