File Coverage

blib/lib/Net/DHCP/Packet/Attributes.pm

Criterion	Covered	Total	%
statement	111	123	90.2
branch	42	52	80.7
condition			n/a
subroutine	30	30	100.0
pod	22	22	100.0
total	205	227	90.3

#!/bin/false
# PODNAME: Net::DHCP::Packet::Attributes
# Author : D. Hamstead
# Original Author: F. van Dun, S. Hadinger
# ABSTRACT: Attribute methods for Net::DHCP::Packet
use strict;
use warnings;
use 5.8.0;

package Net::DHCP::Packet::Attributes;
$Net::DHCP::Packet::Attributes::VERSION = '0.7_007'; # TRIAL

$Net::DHCP::Packet::Attributes::VERSION = '0.7007';# standard module declaration
our ( @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
use Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw( );
@EXPORT_OK = qw(
  comment op htype hlen hops xid secs flags ciaddr
  ciaddrRaw yiaddr yiaddrRaw siaddr siaddrRaw giaddr giaddrRaw
  chaddr chaddrRaw sname file isDhcp padding
);
%EXPORT_TAGS = ( all => \@EXPORT_OK );

use Carp qw/ carp /;
use Net::DHCP::Packet::IPv4Utils qw( packinet unpackinet );

#=======================================================================
# comment attribute : enables transaction number identification
sub comment {
    my $self = shift;
    if (@_) { $self->{comment} = shift }
    return $self->{comment};
}

# op attribute
sub op {
    my $self = shift;
    if (@_) { $self->{op} = shift }
    return $self->{op};
}

# htype attribute
sub htype {
    my $self = shift;
    if (@_) { $self->{htype} = shift }
    return $self->{htype};
}

# hlen attribute
sub hlen {
    my $self = shift;
    if (@_) { $self->{hlen} = shift }
    if ( $self->{hlen} < 0 ) {
        carp( 'hlen must not be < 0 (currently ' . $self->{hlen} . ')' );
        $self->{hlen} = 0;
    }
    if ( $self->{hlen} > 16 ) {
        carp( 'hlen must not be > 16 (currently ' . $self->{hlen} . ')' );
        $self->{hlen} = 16;
    }
    return $self->{hlen};
}

# hops attribute
sub hops {
    my $self = shift;
    if (@_) { $self->{hops} = shift }
    return $self->{hops};
}

# xid attribute
sub xid {
    my $self = shift;
    if (@_) { $self->{xid} = shift }
    return $self->{xid};
}

# secs attribute
sub secs {
    my $self = shift;
    if (@_) { $self->{secs} = shift }
    return $self->{secs};
}

# flags attribute
sub flags {
    my $self = shift;
    if (@_) { $self->{flags} = shift }
    return $self->{flags};
}

# ciaddr attribute
sub ciaddr {
    my $self = shift;
    if (@_) { $self->{ciaddr} = packinet(shift) }
    return unpackinet( $self->{ciaddr} );
}

# ciaddr attribute, Raw version
sub ciaddrRaw {
    my $self = shift;
    if (@_) { $self->{ciaddr} = shift }
    return $self->{ciaddr};
}

# yiaddr attribute
sub yiaddr {
    my $self = shift;
    if (@_) { $self->{yiaddr} = packinet(shift) }
    return unpackinet( $self->{yiaddr} );
}

# yiaddr attribute, Raw version
sub yiaddrRaw {
    my $self = shift;
    if (@_) { $self->{yiaddr} = shift }
    return $self->{yiaddr};
}

# siaddr attribute
sub siaddr {
    my $self = shift;
    if (@_) { $self->{siaddr} = packinet(shift) }
    return unpackinet( $self->{siaddr} );
}

# siaddr attribute, Raw version
sub siaddrRaw {
    my $self = shift;
    if (@_) { $self->{siaddr} = shift }
    return $self->{siaddr};
}

# giaddr attribute
sub giaddr {
    my $self = shift;
    if (@_) { $self->{giaddr} = packinet(shift) }
    return unpackinet( $self->{giaddr} );
}

# giaddr attribute, Raw version
sub giaddrRaw {
    my $self = shift;
    if (@_) { $self->{giaddr} = shift }
    return $self->{giaddr};
}

# chaddr attribute
sub chaddr {
    my $self = shift;
    if (@_) { $self->{chaddr} = pack( 'H*', shift ) }
    return unpack( 'H*', $self->{chaddr} );
}

# chaddr attribute, Raw version
sub chaddrRaw {
    my $self = shift;
    if (@_) { $self->{chaddr} = shift }
    return $self->{chaddr};
}

# sname attribute
sub sname {
    use bytes;
    my $self = shift;
    if (@_) { $self->{sname} = shift }
    if ( length( $self->{sname} ) > 63 ) {
        carp( sprintf q|'sname' must not be > 63 bytes, (currently %d)|,
              length( $self->{sname} ));
        $self->{sname} = substr( $self->{sname}, 0, 63 );
    }
    return $self->{sname};
}

# file attribute
sub file {
    use bytes;
    my $self = shift;
    if (@_) { $self->{file} = shift }
    if ( length( $self->{file} ) > 127 ) {
        carp( sprintf q|'file' must not be > 127 bytes, (currently %d)|,
              length( $self->{file} ));
        $self->{file} = substr( $self->{file}, 0, 127 );
    }
    return $self->{file};
}

# is it DHCP or BOOTP
#   -> DHCP needs magic cookie and options
sub isDhcp {
    my $self = shift;
    if (@_) { $self->{isDhcp} = shift }
    return $self->{isDhcp};
}

# padding attribute
sub padding {
    my $self = shift;
    if (@_) { $self->{padding} = shift }
    return $self->{padding};
}

#=======================================================================

1;

__END__