view release on metacpan or  search on metacpan

lib/BACnet/DataTypes/Date.pm  view on Meta::CPAN

#!/usr/bin/perl

package BACnet::DataTypes::Date;

use warnings;
use strict;

use BACnet::DataTypes::Utils;

use parent 'BACnet::DataTypes::DataType';

use constant { YEAR_OFFSET => 1900 };
use constant { LENGTH      => 4 };

# this did not check if the date make sense or not, because someone may want to use some weird calendar

sub construct {
    my ( $class, $year, $month, $day, $day_of_the_week, $modified_tag ) = @_;

    # $month (1-12), $day, $day_of_the_week (1-7)

    my $self = {
        data            => '',
        year            => $year,
        month           => $month,
        day             => $day,
        day_of_the_week => $day_of_the_week,
    };

    $self->{data} .= BACnet::DataTypes::Utils::_construct_head(
        BACnet::DataTypes::Utils::DATE_TAG,
        $modified_tag, LENGTH );

    if ( defined $year ) {
        $self->{data} .=
          BACnet::DataTypes::Utils::_encode_int_octet_undef( $year - YEAR_OFFSET,
            0xFF );
    }
    else {
        $self->{data} .=
          BACnet::DataTypes::Utils::_encode_int_octet_undef( $year, 0xFF );
    }

    my @date_parts = ( $month, $day, $day_of_the_week );

    for my $date_part (@date_parts) {
        $self->{data} .=
          BACnet::DataTypes::Utils::_encode_int_octet_undef( $date_part, 0xFF );
    }

    return bless $self, $class;
}

sub parse {
    my ( $class, $data_in ) = @_;

    my $data = substr $data_in, 1;
    my $self = bless { data => $data_in, }, $class;

    my $headache = BACnet::DataTypes::Utils::_correct_head(
        data_in         => $data_in,
        expected_tag    => BACnet::DataTypes::Utils::DATE_TAG,
        expected_length => LENGTH,
    );

    if ( $headache ne "" ) {
        $self->{error} = "Date: $headache";
        return $self;
    }

    my $head_len = BACnet::DataTypes::Utils::_get_head_length($data_in);

    $self->{year} =
      BACnet::DataTypes::Utils::_decode_int_octet_undef(
        substr( $data_in, $head_len, 1 ), 0xFF );