view release on metacpan or  search on metacpan

lib/Net/IEC104.pm  view on Meta::CPAN

    35 => {
        "size"     => 10,
        "name"     => "M_ME_TE_1",
        type       => "TI",
        "parse_cb" => \&parse_asdu_type_0_44,
        "write_cb" => \&send_asdu_type_0_44
    },
    36 => {
        "size"     => 12,
        "name"     => "M_ME_TF_1",
        type       => "TI",
        "parse_cb" => \&parse_asdu_type_0_44,
        "write_cb" => \&send_asdu_type_0_44
    },
    37 => {
        "size"     => 12,
        "name"     => "M_IT_TB_1",
        type       => "TII",
        "parse_cb" => \&parse_asdu_type_0_44,
        "write_cb" => \&send_asdu_type_0_44
    },

    # System information to controlled direction, ASDU: 100-109
    100 => {
        "size"     => 1,
        "name"     => "C_IC_NA_1",
        type       => "",
        "parse_cb" => \&parse_asdu_type_100,
        "write_cb" => \&send_asdu_type_100
    },
    103 => {
        "size"     => 7,
        "name"     => "C_CS_NA_1",
        type       => "",
        "parse_cb" => \&parse_asdu_type_103,
        "write_cb" => \&send_asdu_type_103
    },
);

# Constructor
sub new {
    my $self  = shift;
    my %h     = @_;
    my $class = ref($self) || $self;
    croak "wrong type of Net::IEC104"
      if ( $h{type} ne "slave" and $h{type} ne "master" );

    $h{retry_timeout} = ( exists $h{retry_timeout} ) ? $h{retry_timeout} : 5;
    $h{ip}   = ( exists $h{ip} )   ? $h{ip}   : "0.0.0.0";
    $h{port} = ( exists $h{port} ) ? $h{port} : "2404";

    bless \%h, $class;
}

# Print debug messages
sub DEBUG {
    my $d = shift;
    if ( $debug >= $d ) {
        print @_;
        if ( $d < 0 ) {
            printf "<-- at %s:%s", (caller)[ 1, 2 ];
        }
        unless ( $_[$#_] =~ /\s$/ ) {
            print "\n";
        }
    }
}

# Pack ip-port pair as ID of connection
sub get_id {
    my $sock = shift;
    return pack( "C4S", split( /\./, $sock->peerhost ), $sock->peerport );
}

# Unpack ip-port pair to printable form
sub sid2hex {
    return join( ".", map { sprintf "%d", $_ } unpack( "C4S", shift ) );
}

# Print hex-codes of raw data
sub raw2hex {
    return join( ",", map { sprintf "%02X", $_ } unpack( "C*", shift ) );
}

# convert from cp56_2a format of time to gettimeofday
sub cp56_2a_2_time {
    my $data = shift;
    my @tm   = unpack( "SC5", $data );
    my $tm   = Date_SecsSince1970GMT(
        $tm[4] & 0xF,
        $tm[3] & 0x1F,
        2000 + ( $tm[5] & 0x7F ),
        $tm[2] & 0x1F,
        $tm[1] & 0x3F,
        int( $tm[0] / 1000 )
    );
    my $ms = ( $tm[0] % 1000 ) * 1000;
    return ( $tm, $ms );
}

# convert from gettimeofday format to cp56_2a
sub time_2_cp56_2a {
    my $tm = shift;
    my $ms = shift;
    $ms = int( $ms / 1000 );
    my @tm = localtime($tm);
    return pack( "SC5",
        ( $tm[0] * 1000 + $ms ),
        $tm[1],
        $tm[2] | ( $tm[8] << 7 ),
        $tm[3] | ( $tm[6] << 5 ),
        ++$tm[4], $tm[5] % 100 );
}

# debug info about connection
sub sidinfo {
    my $self = shift;
    my $sid  = shift;
    my $report;
    my $s = \%{ $self->{sids}{$sid} };