view release on metacpan or  search on metacpan

lib/Net/DHCPv6/Option/SipServerA.pm  view on Meta::CPAN

#!/bin/false
# ABSTRACT: SIP Server A option (code 22) -- list of IPv6 addresses
# PODNAME: Net::DHCPv6::Option::SipServerA
use strictures 2;

package Net::DHCPv6::Option::SipServerA;
$Net::DHCPv6::Option::SipServerA::VERSION = '0.003';
use Net::DHCPv6::OptionList ();
use Net::DHCPv6::Constants  qw(
    $IPV6_ADDR_LEN $OPTION_SIP_SERVER_A
);
use Net::DHCPv6::X::Truncated ();
use parent 'Net::DHCPv6::Option';
use Ref::Util qw( is_plain_arrayref );
use namespace::clean;
my $EMPTY = q();

sub new {
    my ( $class, %args ) = @_;
    my $addresses = $class->_pick_addrs( \%args, 'servers' );
    if ( !defined $addresses && $args{addresses} ) {
        my $list = is_plain_arrayref( $args{addresses} ) ? $args{addresses} : [ $args{addresses} ];
        $addresses = [ map { $class->_resolve_ipv6( $_ ) } @{$list} ];
    }
    $addresses //= [];
    $args{code} = $OPTION_SIP_SERVER_A;
    $args{data} = join( $EMPTY, @{$addresses} );
    my $self = $class->SUPER::new( %args );
    $self->{servers} = $addresses;
    return bless $self, $class;
}

sub servers_raw { return shift->{servers} }

sub servers {
    my $self = shift;
    return [ map { $self->_format_ipv6( $_ ) } @{ $self->{servers} } ];
}

sub from_bytes_inner {
    my ( $class, $code, $payload ) = @_;
    Net::DHCPv6::X::Truncated->throw( message => 'Truncated SipServerA option' )
        if CORE::length( $payload ) % $IPV6_ADDR_LEN != 0;
    my @addrs;
    while ( CORE::length( $payload ) ) {
        push @addrs, substr( $payload, 0, $IPV6_ADDR_LEN, q() );
    }
    return $class->new( servers_raw => \@addrs );
}

$Net::DHCPv6::OptionList::OPTION_CLASS{$OPTION_SIP_SERVER_A} = __PACKAGE__;
1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Net::DHCPv6::Option::SipServerA - SIP Server A option (code 22) -- list of IPv6 addresses

=head1 VERSION

version 0.003

=head1 SYNOPSIS

  # Text form (auto-resolved to wire bytes)
  my $opt = Net::DHCPv6::Option::SipServerA->new(
      servers => [ '2001:db8::1', '2001:db8::2' ],
  );
  print $opt->servers->[0];           # '2001:db8::1'