#!/usr/bin/env perl

use Net::Telnet;
use Data::Dumper;

#0 Status => 0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
#17 Relative modulation level => 0
#18 CH water pressure => 1.14453125
#25 Boiler water temperature => 53
#26 DHW temperature => 49
#28 Return water temperature => 48.375
#57 Max CH water setpoint => 80
#80 Supply inlet temperature => 21.25
#256 Status => 0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
#257 Control setpoint => 7
#270 Maximum relative modulation level => 100
#272 Room setpoint => 18
#280 Room temperature => 26.7265625
#312 DHW setpoint => 60

my $ot_registers = {
    0 => {
        format => ["flag16"],
        name   => "Status",
        names  => [
            '',            '',
            '',            '',
            '',            '',
            'DHW enabled', 'CH enabled',
            '',            'diagnostic indication',
            '',            '',
            'Flame',       'DHW active',
            'CH active',   'fault'
        ],
        warnings => [
            undef, undef, undef, undef, undef, undef, undef, undef,
            undef, undef, undef, undef, undef, undef, undef, '1'
        ]
    },
    1 => { format => ["f8.8"], name => "Control setpoint", units => 'C' },
    2 => { format => [ "flag8", "u8" ], name => "Master configuration" },
    3 => { format => [ "flag8", "u8" ], name => "Slave configuration" },
    4 => { format => [ "u8",    "u8" ], name => "Remote command" },
    5 => { format => [ "flag8", "u8" ], name => "Application-specific flags" },
    6 => { format => [ "flag8", "flag8" ], name => "Remote parameter flags" },
    7 => { format => ["f8.8"],             name => "Cooling control signal" },
    8 => { format => ["f8.8"],             name => "Control setpoint 2" },
    9 => { format => ["f8.8"], name => "Remote override room setpoint" },
    10 => { format => [ "u8", "nu" ], name => "Number of TSPs" },
    11 => { format => [ "u8", "u8" ], name => "TSP setting" },
    12 => { format => [ "u8", "nu" ], name => "Size of fault buffer" },
    13 => { format => [ "u8", "u8" ], name => "Fault buffer entry" },
    14 => {
        format => ["f8.8"],
        name   => "Maximum relative modulation level",
        units  => '%'
    },
    15 => {
        format => [ "u8", "u8" ],
        name   => "Boiler capacity and modulation limits"
    },
    16 => { format => ["f8.8"], name => "Room setpoint", units => 'C' },
    17 =>
      { format => ["f8.8"], name => "Relative modulation level", units => '%' },
    18 => {
        format   => ["f8.8"],
        name     => "CH water pressure",
        units    => 'bar',
        warning  => '0.9:2.6',
        critical => '0.8:2.8'
    },
    19 => { format => ["f8.8"], name => "DHW flow rate" },
    20 => { format => ["time"], name => "Day of week and time of day" },
    21 => { format => ["date"], name => "Date" },
    22 => { format => ["u16"],  name => "Year" },
    23 => { format => ["f8.8"], name => "Room Setpoint CH2" },
    24 => { format => ["f8.8"], name => "Room temperature", units => 'C' },
    25 =>
      { format => ["f8.8"], name => "Boiler water temperature", units => 'C' },
    26 => { format => ["f8.8"], name => "DHW temperature", units => 'C' },
    27 => { format => ["f8.8"], name => "Outside temperature" },
    28 =>
      { format => ["f8.8"], name => "Return water temperature", units => 'C' },
    29 => { format => ["f8.8"], name => "Solar storage temperature" },
    30 => { format => ["f8.8"], name => "Solar collector temperature" },
    31 => { format => ["f8.8"], name => "Flow temperature CH2" },
    32 => { format => ["f8.8"], name => "DHW2 temperature" },
    33 => { format => ["s16"],  name => "Exhaust temperature" },
    34 => { format => ["f8.8"], name => "Boiler heat exchanger temperature" },
    35 => { format => [ "u8", "u8" ], name => "Boiler fan speed and setpoint" },
    48 => { format => [ "s8", "s8" ], name => "DHW setpoint boundaries" },
    49 => { format => [ "s8", "s8" ], name => "Max CH setpoint boundaries" },
    50 =>
      { format => [ "s8", "s8" ], name => "OTC heat curve ratio boundaries" },
    51 => { format => [ "s8", "s8" ], name => "Remote parameter 4 boundaries" },
    52 => { format => [ "s8", "s8" ], name => "Remote parameter 5 boundaries" },
    53 => { format => [ "s8", "s8" ], name => "Remote parameter 6 boundaries" },
    54 => { format => [ "s8", "s8" ], name => "Remote parameter 7 boundaries" },
    55 => { format => [ "s8", "s8" ], name => "Remote parameter 8 boundaries" },
    56 => { format => ["f8.8"], name => "DHW setpoint",          units => 'C' },
    57 => { format => ["f8.8"], name => "Max CH water setpoint", units => 'C' },
    58 => { format => ["f8.8"], name => "OTC heat curve ratio" },
    59 => { format => ["f8.8"], name => "Remote parameter 4" },
    60 => { format => ["f8.8"], name => "Remote parameter 5" },
    61 => { format => ["f8.8"], name => "Remote parameter 6" },
    62 => { format => ["f8.8"], name => "Remote parameter 7" },
    63 => { format => ["f8.8"], name => "Remote parameter 8" },
    70 => { format => [ "flag8", "flag8" ], name => "Status V/H" },
    71 => { format => [ "nu",    "u8" ],    name => "Control setpoint V/H" },
    72 => { format => [ "flag8", "u8" ],    name => "Fault flags/code V/H" },
    73 => { format => ["u16"], name => "OEM diagnostic code V/H" },
    74 => { format => [ "flag8", "u8" ], name => "Configuration/memberid V/H" },
    75 => { format => ["f8.8"],          name => "OpenTherm version V/H" },
    76 => { format => [ "u8", "u8" ], name => "Product version V/H" },
    77 => { format => [ "nu", "u8" ], name => "Relative ventilation" },
    78 => { format => [ "u8", "u8" ], name => "Relative humidity exhaust air" },
    79 => { format => ["u16"], name => "CO2 level exhaust air" },
    80 =>
      { format => ["f8.8"], name => "Supply inlet temperature", units => 'C' },
    81 => { format => ["f8.8"], name => "Supply outlet temperature" },
    82 => { format => ["f8.8"], name => "Exhaust inlet temperature" },
    83 => { format => ["f8.8"], name => "Exhaust outlet temperature" },
    84 => { format => ["u16"],  name => "Exhaust fan speed" },
    85 => { format => ["u16"],  name => "Inlet fan speed" },
    86 => {
        format => [ "flag8", "flag8" ],
        name   => "Remote parameter settings V/H"
    },
    87  => { format => [ "u8", "nu" ],    name => "Nominal ventilation value" },
    88  => { format => [ "u8", "nu" ],    name => "Number of TSPs V/H" },
    89  => { format => [ "u8", "u8" ],    name => "TSP setting V/H" },
    90  => { format => [ "u8", "nu" ],    name => "Size of fault buffer V/H" },
    91  => { format => [ "u8", "u8" ],    name => "Fault buffer entry V/H" },
    100 => { format => [ "nu", "flag8" ], name => "Remote override function" },
    101 => {
        format => [ "flag8", "flag8" ],
        name   => "Solar storage mode and status"
    },
    102 => { format => [ "flag8", "u8" ], name => "Solar storage fault flags" },
    103 =>
      { format => [ "flag8", "u8" ], name => "Solar storage config/memberid" },
    104 =>
      { format => [ "u8", "u8" ], name => "Solar storage product version" },
    105 => { format => [ "u8", "nu" ], name => "Number of TSPs solar storage" },
    106 => { format => [ "u8", "u8" ], name => "TSP setting solar storage" },
    107 => {
        format => [ "u8", "u8" ],
        name   => "Size of fault buffer solar storage"
    },
    108 =>
      { format => [ "u8", "u8" ], name => "Fault buffer entry solar storage" },
    113 => { format => ["u16"],  name => "Unsuccessful burner starts" },
    114 => { format => ["u16"],  name => "Flame signal too low count" },
    115 => { format => ["u16"],  name => "OEM diagnostic code" },
    116 => { format => ["u16"],  name => "Burner starts" },
    117 => { format => ["u16"],  name => "CH pump starts" },
    118 => { format => ["u16"],  name => "DHW pump/valve starts" },
    119 => { format => ["u16"],  name => "DHW burner starts" },
    120 => { format => ["u16"],  name => "Burner operation hours" },
    121 => { format => ["u16"],  name => "CH pump operation hours" },
    122 => { format => ["u16"],  name => "DHW pump/valve operation hours" },
    123 => { format => ["u16"],  name => "DHW burner operation hours" },
    124 => { format => ["f8.8"], name => "OpenTherm version Master" },
    125 => { format => ["f8.8"], name => "OpenTherm version Slave" },
    126 => { format => [ "u8", "u8" ], name => "Master product version" },
    127 => { format => [ "u8", "u8" ], name => "Slave product version" },
};

my $ot_types = {
    0 => "read data",
    1 => "write data",
    2 => "invalidate data",
    3 => "unknown 0x3",
    4 => "read ack",
    5 => "write ack",
    6 => "data invalid",
    7 => "unknown 0x7"
};

sub decode($$$) {
    my ( $dataref, $string, $offset ) = @_;
    my $b0 = hex( substr( $string, 0, 2 ) );

    my $type = ( $b0 >> 4 ) & 7;
    my $id   = hex( substr( $string, 2, 2 ) );

    my $data   = pack( 'H4', substr( $string, 4, 4 ) );
    my $format = ["u16"];

    my $ret = {
        id       => $id,
        fake_id  => $id + $offset,
        type     => $type,
        type_str => $ot_types->{$type},
    };

    my $bits = undef;

    if ( exists $ot_registers->{$id} ) {
        $ret->{id_str} = $ot_registers->{$id}->{name};
        $ret->{units}  = $ot_registers->{$id}->{units};
        $format        = $ot_registers->{$id}->{format};
        $bits          = $ot_registers->{$id}->{names};
    }

    $ret->{format}  = join( ',', @$format );
    $ret->{raw_hex} = substr( $string, 4, 4 );
    $ret->{raw}     = $data;

    $ret->{values} = [];
    for my $f (@$format) {

        if ( $f eq "u16" ) {
            push @{ $ret->{values} }, unpack( 'S>', $data );
            $data = substr( $data, 2 );
        }
        elsif ( $f eq 's16' ) {
            push @{ $ret->{values} }, unpack( 's>', $data );
            $data = substr( $data, 2 );
        }
        elsif ( $f eq 'u8' ) {
            push @{ $ret->{values} }, unpack( 'C', $data );
            $data = substr( $data, 1 );
        }
        elsif ( $f eq 's8' ) {
            push @{ $ret->{values} }, unpack( 'c', $data );
            $data = substr( $data, 1 );
        }
        elsif ( $f eq 'nu' ) {
            $data = substr( $data, 1 );
        }
        elsif ( $f eq 'flag16' ) {
            push @{ $ret->{values} },
              ( unpack( "(A)*", unpack( "B16", $data ) ) );
            $data = substr( $data, 2 );
        }
        elsif ( $f eq 'flag8' ) {
            push @{ $ret->{values} },
              ( unpack( "(A)*", unpack( "B8", $data ) ) );
            $data = substr( $data, 1 );
        }
        elsif ( $f eq 'f8.8' ) {
            push @{ $ret->{values} }, unpack( 's>', $data ) / 256.0;
        }

    }

    $dataref->{ $id + $offset } = $ret;

    if ( defined $bits ) {
        my @vs  = ( @{ $ret->{values} } );
        my $bit = scalar( @{ $ret->{values} } );

        for my $label (@$bits) {
            $bit--;
            my $v = shift(@vs);
            next unless length($label) > 0;
            my $key = sprintf( "%d.%d", $id + $offset, $bit );
            $ret = {};

            $ret->{id}       = sprintf( "%d.%d", $id, $bit );
            $ret->{fake_id}  = $key;
            $ret->{type}     = $type;
            $ret->{type_str} = $ot_types->{$type};
            $ret->{id_str}   = $label;
            $ret->{values}   = [$v];

            $dataref->{$key} = $ret;
        }
    }

    return $ret;
}

sub thermostat($$) {
    my ( $string, $data ) = @_;

    return decode( $data, $string, 0x100 );

}

sub boiler($$) {
    my ( $string, $data ) = @_;

    return decode( $data, $string, 0x0 );

}

sub get_units($) {
    my $id = shift;

    if ( $id =~ /^\d+$/ ) {
        return '' unless exists $ot_registers->{$id};
        return '' unless exists $ot_registers->{$id}->{units};
        return $ot_registers->{$id}->{units};
    }
    elsif ( $id =~ /^(\d+)\.(\d+)$/ ) {
        my $base_id = $1;
        my $bit     = $2;

        return '' unless exists $ot_registers->{$base_id};
        return '' unless exists $ot_registers->{$base_id}->{unitss};

        $bit =
          ( scalar( @{ $ot_registers->{$base_id}->{unitss} } ) - 1 ) - $bit;
        return $ot_registers->{$base_id}->{unitss}->[$bit];
    }
    else {
        return '';
    }
}

sub get_name($) {
    my $id = shift;

    if ( $id =~ /^\d+$/ ) {
        return "Unknown $id" unless exists $ot_registers->{$id};
        return $ot_registers->{$id}->{name};
    }
    elsif ( $id =~ /^(\d+)\.(\d+)$/ ) {
        my $base_id = $1;
        my $bit     = $2;

        return "Unknown $id" unless exists $ot_registers->{$base_id};
        return "Unknown $id" unless exists $ot_registers->{$base_id}->{names};

        $bit = ( scalar( @{ $ot_registers->{$base_id}->{names} } ) - 1 ) - $bit;
        return $ot_registers->{$base_id}->{names}->[$bit];
    }
    else {
        return undef;
    }
}

sub get_warning($) {
    my $id = shift;

    if ( $id =~ /^\d+$/ ) {
        return "Unknown $id" unless exists $ot_registers->{$id};
        return $ot_registers->{$id}->{warning};
    }
    elsif ( $id =~ /^(\d+)\.(\d+)$/ ) {
        my $base_id = $1;
        my $bit     = $2;

        return "Unknown $id" unless exists $ot_registers->{$base_id};
        return "Unknown $id" unless exists $ot_registers->{$base_id}->{names};

        $bit =
          ( scalar( @{ $ot_registers->{$base_id}->{warnings} } ) - 1 ) - $bit;
        return $ot_registers->{$base_id}->{warnings}->[$bit];
    }
    else {
        return undef;
    }
}

sub get_critical($) {
    my $id = shift;

    if ( $id =~ /^\d+$/ ) {
        return "Unknown $id" unless exists $ot_registers->{$id};
        return $ot_registers->{$id}->{crtitical};
    }
    elsif ( $id =~ /^(\d+)\.(\d+)$/ ) {
        my $base_id = $1;
        my $bit     = $2;

        return "Unknown $id" unless exists $ot_registers->{$base_id};
        return "Unknown $id" unless exists $ot_registers->{$base_id}->{names};

        $bit =
          ( scalar( @{ $ot_registers->{$base_id}->{crtiticals} } ) - 1 ) - $bit;
        return $ot_registers->{$base_id}->{crtiticals}->[$bit];
    }
    else {
        return undef;
    }
}

sub maul($) {
    my $n = shift;

    $n =~ s/\s/_/g;
    return "boiler_" . lc($n);
}

my $report = [
    '0.0', '0.1', '0.2', '0.3', '0.6', '0.8', '0.9', '17',  '18', '25',
    '26',  '28',  '57',  '80',  '257', '270', '272', '280', '312'
];

sub do_thing($) {
    my $t = shift;

    my $name     = get_name($t);
    my $maul     = maul($name);
    my $warning  = get_warning($t);
    my $critical = get_critical($t);

    print "$maul.draw LINE2\n";
    print "$maul.type GAUGE\n";
    print "$maul.label $name\n";

    print "$maul.warning ",  $warning,  "\n" if $warning;
    print "$maul.critical ", $critical, "\n" if $critical;
}

sub do_units($) {
    my $want_unit = shift;

    for my $t (@$report) {
        my $unit = get_units($t);

        next unless $want_unit eq $unit;
        do_thing($t);
    }
}

sub do_values_units($$) {
    my ( $data, $wanted_units ) = @_;

    for my $t (@$report) {
        next unless exists $data->{$t};

        my $units = get_units($t);
        next unless $units eq $wanted_units;

        my $name = get_name($t);
        my $maul = maul($name);

        print $maul, ".value ", $data->{$t}->{values}->[0], "\n";
    }
}

my $wanted   = { map { my $q = $_; $q =~ s/\..*$//; $q => 1 } @$report };
my $n_wanted = scalar( keys %$wanted );

for my $t ( keys %$ot_registers ) {
    $ot_registers->{ $t + 0x100 } = $ot_registers->{$t};
}

my @bits = split( /_+/, $0 );

exit 0 unless scalar(@bits) > 1;

my $host = $bits[1];

$host =~ s/-//g;

my $short_host = $host;

$short_host =~ s/\..*$//;

if ( $ARGV[0] eq 'config' ) {

    print "host_name ", $host, "\n";

    print "multigraph temperatures_${short_host}\n";
    print "graph_title Temperatures\n";
    print "graph_category boiler\n";
    print "graph_vlabel centigrade\n";

    do_units('C');

    print "multigraph pressures_${short_host}\n";
    print "graph_title Pressures\n";
    print "graph_category boiler\n";
    print "graph_vlabel bar\n";

    do_units('bar');

    print "multigraph modulation_${short_host}\n";
    print "graph_title Modulation\n";
    print "graph_category boiler\n";
    print "graph_vlabel bar\n";

    do_units('%');

    for my $t (@$report) {
        next if length( get_units($t) ) > 0;

        my $name = get_name($t);
        my $maul = maul($name);

        print "multigraph ${maul}_${short_host}\n";
        print "graph_title $name\n";
        print "graph_category boiler\n";

        do_thing($t);

    }

    exit(0);
}

my $telnet = new Net::Telnet(
    Timeout    => 10,
    Telnetmode => 0,
    Binmode    => 1,
    Host       => $bits[1],
    Port       => 2001
);

#$telnet->open($bits[1]);

my $data    = {};
my $then    = time;
my $timeout = 60;

while ( ($n_wanted) and ( ( time - $then ) < $timeout ) ) {
    my $line = $telnet->getline( Timeout => 1, Errmode => 'return' );
    my $id   = -1;

    chomp $line;
    chomp $line;

    if ( $line =~ /^T/ ) {
        $id = thermostat( substr( $line, 1, 8 ), $data );
    }
    elsif ( $line =~ /^B/ ) {
        $id = boiler( substr( $line, 1, 8 ), $data );
    }

    if ( exists $wanted->{$id} ) {
        $n_wanted--;
        delete $wanted->{$id};
    }

}

print "multigraph temperatures_${short_host}\n";
do_values_units( $data, 'C' );
print "multigraph pressures_${short_host}\n";
do_values_units( $data, 'bar' );
print "multigraph modulation_${short_host}\n";
do_values_units( $data, '%' );

for my $t (@$report) {
    next unless exists $data->{$t};

    my $units = get_units($t);
    next unless $units eq '';

    my $name = get_name($t);
    my $maul = maul($name);

    print "multigraph ${maul}_${short_host}\n";
    print $maul, ".value ", $data->{$t}->{values}->[0], "\n";
}

exit(0);