File Coverage

blib/lib/TinyDNS/Record.pm

Criterion	Covered	Total	%
statement	86	91	94.5
branch	22	30	73.3
condition	17	30	56.6
subroutine	13	13	100.0
pod	1	9	11.1
total	139	173	80.3

=head1 NAME

TinyDNS::Record - Parse a single TinyDNS Record.

=head1 DESCRIPTION

This module provides an object API to a single TinyDNS record/line.

It is not quite valid because:

=over 8

=item *
We ignore NS and SOA records, which Amazon would handle for us.

=item *
Our TXT records handling uses "T" not ":".

=item *
Our MX record handling allows a name to be set with no IP.

=back

There are probably other differences.

=cut

=head1 AUTHOR

Steve Kemp <[e-mail]>

=cut

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2014 Steve Kemp <[e-mail]>.

This code was developed for an online Git-based DNS hosting solution,
which can be found at:

=over 8

=item *
https://dns-api.com/

=back

This library is free software. You can modify and or distribute it under
the same terms as Perl itself.

=cut


use strict;
use warnings;

package TinyDNS::Record;


use Carp;


#
#  Allow our object to treated as a string.
#
use overload '""' => 'stringify';



=begin doc

Constructor.

Set the type of the object.

=end doc

=cut

sub new
{
    my ( $proto, $line ) = (@_);
    my $class = ref($proto) || $proto;

    my $self = {};
    bless( $self, $class );

    #
    #  The record-type is the first character.
    #
    my $rec = substr( $line, 0, 1 );

    #
    #  Remove the record-type from the line
    #
    $line = substr( $line, 1 );

    #
    # Tokenize - NOTE This is ignored for TXT records,
    # (because a TXT record used for SPF might have an embedded
    # ":" for example.)
    #
    my @data = split( /:/, $line );

    #
    #  Nasty parsing for each record type..
    #
    #  We should do better.
    #
    #
    if ( ( $rec eq '+' ) || ( $rec eq '=' ) )
    {

        # name : ipv4 : ttl
        $self->{ 'type' }  = "A";
        $self->{ 'name' }  = $data[0];
        $self->{ 'value' } = $data[1];
        $self->{ 'ttl' }   = $data[2] || 300;
    }
    elsif ( $rec eq '6' )
    {

        # name : ipv6 : ttl
        $self->{ 'type' } = "AAAA";
        $self->{ 'name' } = $data[0];
        $self->{ 'ttl' }  = $data[2] || 300;

        #
        #  Convert an IPv6 record of the form:
        #     "200141c8010b01010000000000000010"
        #  to the expected value:
        #     "2001:41c8:010b:0101:0000:0000:0000:0010".
        #
        my $ipv6 = $data[1];
        my @tmp = ( $ipv6 =~ m/..../g );
        $self->{ 'value' } = join( ":", @tmp );
    }
    elsif ( $rec eq '@' )
    {

        #
        # @xxx:name:ttl
        # @xxx:[ip]:name:ttl
        #
        if ( scalar(@data) == 4 )
        {
            $self->{ 'type' }     = "MX";
            $self->{ 'name' }     = $data[0];
            $self->{ 'priority' } = $data[3] || "15";
            $self->{ 'ttl' }      = $data[4] || 300;
            $self->{ 'value' }    = $self->{ 'priority' } . " " . $data[2];
        }
        if ( scalar(@data) == 3 )
        {
            $self->{ 'type' }     = "MX";
            $self->{ 'name' }     = $data[0];
            $self->{ 'priority' } = $data[2] || "15";
            $self->{ 'ttl' }      = $data[3] || 300;
            $self->{ 'value' }    = $self->{ 'priority' } . " " . $data[1];
        }
    }
    elsif ( ( $rec eq 'c' ) || ( $rec eq 'C' ) )
    {

        #
        # name :  dest : [ttl]
        #
        $self->{ 'type' }  = "CNAME";
        $self->{ 'name' }  = $data[0];
        $self->{ 'value' } = $data[1];
        $self->{ 'ttl' }   = $data[2] || 300;
    }
    elsif ( ( $rec eq 't' ) || ( $rec eq 'T' ) )
    {

        #
        # name : "data " : [TTL]
        #
        if ( $line =~ /([^:]+):"([^"]+)":([0-9]+)$/ )
        {
            $self->{ 'type' }  = "TXT";
            $self->{ 'name' }  = $1;
            $self->{ 'value' } = "\"$2\"";
            $self->{ 'ttl' }   = $3;
        }
        else
        {
            die "Invalid TXT record - $line\n";
        }
    }
    elsif ( $rec eq '^' )
    {

        #
        #  ptr : "rdns " : [TTL]
        #
        $self->{ 'type' }  = "PTR";
        $self->{ 'name' }  = $data[0];
        $self->{ 'value' } = $data[1];
        $self->{ 'ttl' }   = $data[2] || 300;
    }
    else
    {
        carp "Unknown record type [$rec]: $line";
        return undef;
    }
    return $self;

}


=begin doc

Is the given record valid?  If it has a type then it must be.

=end doc

=cut

sub valid
{
    my ($self) = (@_);

    return ( $self->{ 'type' } ? 1 : 0 );
}


=begin doc

Get the type of record this object holds.

=end doc

=cut

sub type
{
    my ($self) = (@_);

    return ( $self->{ 'type' } );
}


=begin doc

Get the TTL of this object.

=end doc

=cut

sub ttl
{
    my ($self) = (@_);
    return ( $self->{ 'ttl' } || 300 );
}


=begin doc

Get the name of this record.

=end doc

=cut

sub name
{
    my ($self) = (@_);
    return ( $self->{ 'name' } );
}


=begin doc

Get the value of this record.

=end doc

=cut

sub value
{
    my ($self) = (@_);

    return ( $self->{ 'value' } );
}


=begin doc

Add a new value to the existing record.

This is added by the L<TinyDNS::Reader::Merged> module.

=end doc

=cut

sub add
{
    my ( $self, $addition ) = (@_);

    my $value = $self->{ 'value' };
    if ( ref \$value eq "SCALAR" )
    {
        my $x;
        push( @$x, $value );
        push( @$x, $addition );
        $self->{ 'value' } = $x;
    }
    else
    {
        push( @$value, $addition );
        $self->{ 'value' } = $value;
    }
}


=begin doc

Conver the record to a string, suitable for printing.

=end doc

=cut

sub stringify
{
    my ($self) = (@_);
    my $txt = "";

    $txt .= ( "Type " . $self->type() . "\n" )    if ( $self->type() );
    $txt .= ( " Name:" . $self->name() . "\n" )   if ( $self->name() );
    $txt .= ( " Value:" . $self->value() . "\n" ) if ( $self->value() );
    $txt .= ( " TTL:" . $self->ttl() . "\n" )     if ( $self->ttl() );

}

sub hash
{
    my ($self) = (@_);

    my $hash;
    $hash .= $self->type();
    $hash .= $self->name();
    $hash .= $self->value();
    $hash .= $self->ttl();

    return ($hash);
}

1;