Zählerabfrage als Wiregate Plugin

Dieses Thema ist geschlossen.

gklein antwortet

12.03.2013, 18:22
den Fehler hatte ich auch,
kam meistens wenn der reguläre Ausdruck nichts gefunden hat. Damit war $1 leer und dann ging er auf die Bretter. (Müsste man mal abfangen ;-) )

Lass Dir mal über Print die Variable ($sml_val) vor Anwendung des regulären Ausrucks anzeigen und dann $1. Dan kannst Du quasi von Hand schauen ob das passen würde - oder hier Posten.

Grüße
Gunnar
Einen Kommentar schreiben:
JuMi2006 antwortet

12.03.2013, 17:56
Häng mal noch das script mit an Deinen Post, damit man die Zeilen zuordnen kann.
Einen Kommentar schreiben:

lio123 antwortet

12.03.2013, 17:43

da scheint was im code zu sein

Code:

#!/usr/bin/perl

use warnings;
use strict;
use Device::SerialPort;
use feature "switch";
use EIBConnection;
use RRDs;
use Fcntl qw(:DEFAULT :flock);


#0701000F0700FF = 7.0       FIXME !!! [0F]0700
#070100010801FF = 1.8.1
#070100010800FF = 1.8.1

# Lock setzen damit Skript nur einmal startet


  open  *{0}
        or die "What!? $0:$!";
  flock *{0}, LOCK_EX|LOCK_NB
    or die "$0 is already running somewhere!\n";


my $eib_url = "local:/tmp/eib";     #for local eibd "local:/tmp/eib" for eibd in LAN: "ip:192.168.2.220:6720"
my $device = "/dev/usbserial-A601NKCL";
my $repeat = 20;   # Wiederholung alle x Sekunden
my $rrdpath = "/var/www/rrd";
my $debug = 1;

my @obis;


push @obis,{obis=>"1.8.0",  fact=>10000, ga =>"14/7/51", dpt => 14, rrd_name => "Zaehler_Verbrauch", rrd => "c"   }; #rrd: c=counter ; g=gauge
push @obis,{obis=>"15.7.0",    fact=>10,    ga =>"14/7/50", dpt => 9 , rrd_name => "Zaehler_Leistung",  rrd => "g" };


my @countermodes = (5,15,60,1440);    #Aufloesungen fuer COUNTER RRDs in Minuten (1440 = Tagesverbrauch)


my $port = Device::SerialPort->new($device) || die $!;

$port->databits(8) || die "failed setting databits";
$port->baudrate(9600) || die "failed setting baudrate";
$port->parity("none") || die "failed setting parity";
$port->stopbits(1);
$port->handshake("none");
$port->dtr_active(0);
$port->purge_all();
$port->read_char_time(0);     # don't wait for each character
$port->read_const_time(4000); # 1 second per unfulfilled "read" call
$port->write_settings || die "cannot write settings";


# Loop zum Datenempfang

my $error=0;

while ($error != 1)
{

   my ($x,$data) = 0 ;
   my $sml = 0;
   my $start = 0;
   my $value = 0;
   my $dec_value = 0;
   my $count = 0;
   my $saw = 0;

   if ($debug == 1) {print "Step 1 - Daten holen \n";}

   while ($start < 2)  # wait for second 1B1B1B1B01010101
     {
      ($count,$saw)=$port->read(512);   # will read 512 chars
      if ($count == 512)       # wurden 512 chars gelesen ?
        {
         $x = uc(unpack('H*',$saw)); # nach hex wandeln
         $data .= $x;
         if ($data =~ /1B1B1B1B01010101/)  {$start ++};
        } # if
     }  # while

   if ($debug==1) {print "Step 2 - Reg Exp 1 Datensatz zusammensetzen \n";}
   $data =~ m/1B1B1B1B01010101(.*?)B1B1B1/;
   $sml = $1;

   print "Zaehler Haushalt: \n";

   if ($debug==1) {print "Step 3 - Datensatz auswerten \n";}

   foreach my $obiscnt (@obis)
    {
     # Umwandeln OBIS in HEx
my $hc ="";
foreach my $c (split(/\./,$obiscnt->{obis})) {
$hc .= sprintf("%02X", $c);
}
my $obissearch = $hc;
     # FF fuer Suche an  Hex-Wert anhaegne
     $obissearch .="FF";
     if ($debug==1) { print $obissearch."     Obis\n";}
     $sml =~ m/$obiscnt->{obis}(.*?)0177/;
     my $sml_val = $1;

     if ($debug==1)  {  print $1." contains hex \n";}

     #extract value
     $sml_val =~ s/^.*52FF//;
     $sml_val = substr($sml_val,2);
     if ($debug == 1) {  print $sml_val." hex \n";}
     $value = $sml_val;

     $dec_value = sprintf("%d", hex($value));
     $dec_value /= $obiscnt->{fact};
     print $dec_value."<<<<---- Wert\n";

     #  RRD-Graphen erstellen  - bei Bedarf wieder aktiv setzen
     #if ($obis->{rrd} eq "c")
     #   {
     #   &rrd_counter ($obis->{rrd_name},$dec_value)
     #   }
     #if ($obis->{rrd} eq "g")
     #   {
     #   &rrd_gauge ($obis->{rrd_name},$dec_value)
     #   }

     &knx_write ($obiscnt->{ga},$dec_value,$obiscnt->{dpt});
     if ($debug == 1) {print "GA:".$obiscnt->{ga}." Wert:".$dec_value." DPT:".$obiscnt->{dpt}."\n";}

    } # foreach

    sleep $repeat;

} # while

$port->close() || warn "Serial port did not close proper!\n";
undef $port;

### SUBS ###


sub rrd_counter
{
    if ($debug==1){print ("COUNTER","\n")};
    foreach (@countermodes)
    {
        my $obisname = $_[0];
        if ($debug==1){print $obisname." obisname \n";}
        my $value = $_[1];
        if ($debug==1){print $value." value \n";}
        my $rrdname = $obisname."_".$_."\.rrd";
        if ($debug==1){print ($rrdname,"\n")};
        my $rrdfile = $rrdpath."\/".$rrdname;
        unless (-e $rrdfile)
        {
            RRDs::create ($rrdfile,"DS:value:COUNTER:".(($_*60)+600).":0:10000000000","RRA:AVERAGE:0.5:1:365","RRA:AVERAGE:0.5:7:300","-s ".($_*60));
        }
        my $countervalue = int($value*$_*60);
        RRDs::update("$rrdfile", "N:$countervalue");
    }
}

sub rrd_gauge
{
    if ($debug==1){print ("GAUGE","\n")};
    my $obisname = $_[0];
    if ($debug==1){print $obisname." obisname \n";}
    my $value = $_[1];
    if ($debug==1){print $value." value \n";}
    my $rrdname = $obisname."\.rrd";
    if ($debug==1){print ($rrdname,"\n")};
    my $rrdfile = $rrdpath."\/".$rrdname;
    unless (-e $rrdfile)
    {
        RRDs::create ($rrdfile,"DS:value:GAUGE:900:0:10000000000","RRA:AVERAGE:0.5:1:2160","RRA:AVERAGE:0.5:5:2016","RRA:AVERAGE:0.5:15:2880","RRA:AVERAGE:0.5:60:8760");
    }
    RRDs::update("$rrdfile", "N:$value");
}


sub knx_write {
    my ($dst,$value,$dpt,$response,$dbgmsg) = @_;
    my $bytes;
    my $apci = ($response) ? 0x40 : 0x80; # 0x40=response, 0x80=write
    #     DPT 1 (1 bit) = EIS 1/7 (move=DPT 1.8, step=DPT 1.7)
    #     DPT 2 (1 bit controlled) = EIS 8
    #     DPT 3 (3 bit controlled) = EIS 2
    #     DPT 4 (Character) = EIS 13
    #     DPT 5 (8 bit unsigned value) = EIS 6 (DPT 5.1) oder EIS 14.001 (DPT 5.10)
    #     DPT 6 (8 bit signed value) = EIS 14.000
    #     DPT 7 (2 byte unsigned value) = EIS 10.000
    #     DPT 8 (2 byte signed value) = EIS 10.001
    #     DPT 9 (2 byte float value) = EIS 5
    #     DPT 10 (Time) = EIS 3
    #     DPT 11 (Date) = EIS 4
    #     DPT 12 (4 byte unsigned value) = EIS 11.000
    #     DPT 13 (4 byte signed value) = EIS 11.001
    #     DPT 14 (4 byte float value) = EIS 9
    #     DPT 15 (Entrance access) = EIS 12
    #     DPT 16 (Character string) = EIS 15
    # $dpt = $eibgaconf{$dst}{'DPTSubId'} unless $dpt; # read dpt from eibgaconf if existing
    given ($dpt) {
        when (/^12/)             { $bytes = pack ("CCL>", 0, $apci, $value); }  #EIS11.000/DPT12 (4 byte unsigned)
        when (/^13/)             { $bytes = pack ("CCl>", 0, $apci, $value); }
        when (/^14/)             { $bytes = pack ("CCf>", 0, $apci, $value); }
        when (/^16/)             { $bytes = pack ("CCa14", 0, $apci, $value); }
        when (/^17/)             { $bytes = pack ("CCC", 0, $apci, $value & 0x3F); }
        when (/^20/)             { $bytes = pack ("CCC", 0, $apci, $value); }
        when (/^\d\d/)           { return; } # other DPT XX 15 are unhandled
        when (/^[1,2,3]/)        { $bytes = pack ("CC", 0, $apci | ($value & 0x3f)); } #send 6bit small
        when (/^4/)              { $bytes = pack ("CCc", 0, $apci, ord($value)); }
        when ([5,5.001])         { $bytes = pack ("CCC", 0, $apci, encode_dpt5($value)); } #EIS 6/DPT5.001 1byte
        when ([5.004,5.005,5.010]) { $bytes = pack ("CCC", 0, $apci, $value); }
        when (/^5/)              { $bytes = pack ("CCC", 0, $apci, $value); }
        when (/^6/)              { $bytes = pack ("CCc", 0, $apci, $value); }
        when (/^7/)              { $bytes = pack ("CCS>", 0, $apci, $value); }
        when (/^8/)              { $bytes = pack ("CCs>", 0, $apci, $value); }
        when (/^9/)              { $bytes = pack ("CCCC", 0, $apci, encode_dpt9($value)); } #EIS5/DPT9 2byte float
        default                  { LOGGER('WARN',"None or unsupported DPT: $dpt sent to $dst value $value"); return; }
    }
    my $leibcon = EIBConnection->EIBSocketURL($eib_url) or return("Error opening con: $!");
    if ($leibcon->EIBOpenT_Group(str2addr($dst),1) == -1) { return("Error opening group: $!"); }
    my $res=$leibcon->EIBSendAPDU($bytes);
    $leibcon->EIBClose();
    return $res;
    
    # str2addr: Convert an EIB address string in the form "1/2/3" or "1.2.3" to an integer
    sub str2addr {
        my $str = $_[0];
        if ($str =~ /(\d+)\/(\d+)\/(\d+)/) { # logical address
            return ($1 << 11) | ($2 << 8) | $3;
        } elsif ($str =~ /(\d+)\.(\d+)\.(\d+)/) { # physical address
            return ($1 << 12) | ($2 << 8) | $3;
        } else {
            #bad
            return;
        }
    }
    
}

sub encode_dpt9
{
    # 2byte signed float
    my $state = shift;
    my $data;
    my $sign = ($state <0 ? 0x8000 : 0);
    my $exp  = 0;
    my $mant = 0;
    $mant = int($state * 100.0);
    while (abs($mant) > 2047)
    {
        $mant /= 2;
        $exp++;
    }
    $data = $sign | ($exp << 11) | ($mant & 0x07ff);
    return $data >> 8, $data & 0xff;
}

Code:

Step 1 - Daten holen
Step 2 - Reg Exp 1 Datensatz zusammensetzen
Zaehler Haushalt:
Step 3 - Datensatz auswerten
010800FF     Obis
FF63018201621E52FF5600050D8E9C contains hex
00050D8E9C hex
8477.4556<<<<---- Wert
GA:14/7/51 Wert:8477.4556 DPT:14
0F0700FF     Obis
Use of uninitialized value $1 in concatenation (.) or string at /home/user/smlMarch.pl line 105.
 contains hex
Use of uninitialized value $sml_val in substitution (s///) at /home/user/smlMarch.pl line 108.
Use of uninitialized value $sml_val in substr at /home/user/smlMarch.pl line 109.
substr outside of string at /home/user/smlMarch.pl line 109.
Use of uninitialized value $sml_val in concatenation (.) or string at /home/user/smlMarch.pl line 110.
 hex
Use of uninitialized value $value in hex at /home/user/smlMarch.pl line 113.
0<<<<---- Wert
GA:14/7/50 Wert:0 DPT:9

Einen Kommentar schreiben:

JuMi2006 antwortet

12.03.2013, 16:51
Code:

killall name.pl
Einen Kommentar schreiben:
lio123 antwortet

12.03.2013, 16:50
danke Mirko,

jetzt sagt er, dass das schon woanders running ist. Cronjob steht
Einen Kommentar schreiben:
JuMi2006 antwortet

12.03.2013, 16:35
Code:

perl /hier/liegt/mein/script/name.pl
Einen Kommentar schreiben:
lio123 antwortet

12.03.2013, 16:33
benötige hilfe:

Putty läuft, debug=1.
Was muss ich nun auf der Konsole eingeben?

Dnke und Grüße,
Lio
Einen Kommentar schreiben:
lio123 antwortet

11.03.2013, 23:39
jetzt funktioniert putty auf ein mak nimmer... hab die WinSCP- portable. Muss das auf morgen verschieben-mir brummt der Schädel.
Dann geb ich den Pfad und den Namen des Plugins ein und bekomme den Output angezeigt?

Danke und Grüße,
Lio
Einen Kommentar schreiben:
JuMi2006 antwortet

11.03.2013, 23:19
Einfach $debug = 1 setzen und in der Konsole aufrufen.
Einen Kommentar schreiben:

lio123 antwortet

11.03.2013, 23:12

das hat nicht bewirkt. Da stand aber auch vorher schon
push @obis,{obis=>"7.0", fact=>10,

kann ich den Wert as einem Log auslesen?
Momentan kann ich das Ergebnis nur in der Comet sehen.

Code:

#!/usr/bin/perl

use warnings;
use strict;
use Device::SerialPort;
use feature "switch";
use EIBConnection;
use RRDs;
use Fcntl qw(:DEFAULT :flock);


#0701000F0700FF = 7.0       FIXME !!! [0F]0700
#070100010801FF = 1.8.1
#070100010800FF = 1.8.1

# Lock setzen damit Skript nur einmal startet


  open  *{0}
        or die "What!? $0:$!";
  flock *{0}, LOCK_EX|LOCK_NB
    or die "$0 is already running somewhere!\n";


my $eib_url = "local:/tmp/eib";     #for local eibd "local:/tmp/eib" for eibd in LAN: "ip:192.168.2.220:6720"
my $device = "/dev/usbserial-A601NKCL";
my $repeat = 20;   # Wiederholung alle x Sekunden
my $rrdpath = "/var/www/rrd";
my $debug = 0;

my @obis;


push @obis,{obis=>"1.8.0",  fact=>10000, ga =>"14/7/51", dpt => 14, rrd_name => "Zaehler_Verbrauch", rrd => "c"   }; #rrd: c=counter ; g=gauge
push @obis,{obis=>"15.7.0",    fact=>10,    ga =>"14/7/50", dpt => 9 , rrd_name => "Zaehler_Leistung",  rrd => "g" };


my @countermodes = (5,15,60,1440);    #Aufloesungen fuer COUNTER RRDs in Minuten (1440 = Tagesverbrauch)


my $port = Device::SerialPort->new($device) || die $!;

$port->databits(8) || die "failed setting databits";
$port->baudrate(9600) || die "failed setting baudrate";
$port->parity("none") || die "failed setting parity";
$port->stopbits(1);
$port->handshake("none");
$port->dtr_active(0);
$port->purge_all();
$port->read_char_time(0);     # don't wait for each character
$port->read_const_time(4000); # 1 second per unfulfilled "read" call
$port->write_settings || die "cannot write settings";


# Loop zum Datenempfang

my $error=0;

while ($error != 1)
{

   my ($x,$data) = 0 ;
   my $sml = 0;
   my $start = 0;
   my $value = 0;
   my $dec_value = 0;
   my $count = 0;
   my $saw = 0;

   if ($debug == 1) {print "Step 1 - Daten holen \n";}

   while ($start < 2)  # wait for second 1B1B1B1B01010101
     {
      ($count,$saw)=$port->read(512);   # will read 512 chars
      if ($count == 512)       # wurden 512 chars gelesen ?
        {
         $x = uc(unpack('H*',$saw)); # nach hex wandeln
         $data .= $x;
         if ($data =~ /1B1B1B1B01010101/)  {$start ++};
        } # if
     }  # while

   if ($debug==1) {print "Step 2 - Reg Exp 1 Datensatz zusammensetzen \n";}
   $data =~ m/1B1B1B1B01010101(.*?)B1B1B1/;
   $sml = $1;

   print "Zaehler Haushalt: \n";

   if ($debug==1) {print "Step 3 - Datensatz auswerten \n";}

   foreach my $obiscnt (@obis)
    {
     # Umwandeln OBIS in HEx
my $hc ="";
foreach my $c (split(/\./,$obiscnt->{obis})) {
$hc .= sprintf("%02X", $c);
}
my $obissearch = $hc;
     # FF fuer Suche an  Hex-Wert anhaegne
     $obissearch .="FF";
     if ($debug==1) { print $obissearch."     Obis\n";}
     $sml =~ m/$obiscnt->{obis}(.*?)0177/;
     my $sml_val = $1;

     if ($debug==1)  {  print $1." contains hex \n";}

     #extract value
     $sml_val =~ s/^.*52FF//;
     $sml_val = substr($sml_val,2);
     if ($debug == 1) {  print $sml_val." hex \n";}
     $value = $sml_val;

     $dec_value = sprintf("%d", hex($value));
     $dec_value /= $obiscnt->{fact};
     print $dec_value."<<<<---- Wert\n";

     #  RRD-Graphen erstellen  - bei Bedarf wieder aktiv setzen
     #if ($obis->{rrd} eq "c")
     #   {
     #   &rrd_counter ($obis->{rrd_name},$dec_value)
     #   }
     #if ($obis->{rrd} eq "g")
     #   {
     #   &rrd_gauge ($obis->{rrd_name},$dec_value)
     #   }

     &knx_write ($obiscnt->{ga},$dec_value,$obiscnt->{dpt});
     if ($debug == 1) {print "GA:".$obiscnt->{ga}." Wert:".$dec_value." DPT:".$obiscnt->{dpt}."\n";}

    } # foreach

    sleep $repeat;

} # while

$port->close() || warn "Serial port did not close proper!\n";
undef $port;

### SUBS ###


sub rrd_counter
{
    if ($debug==1){print ("COUNTER","\n")};
    foreach (@countermodes)
    {
        my $obisname = $_[0];
        if ($debug==1){print $obisname." obisname \n";}
        my $value = $_[1];
        if ($debug==1){print $value." value \n";}
        my $rrdname = $obisname."_".$_."\.rrd";
        if ($debug==1){print ($rrdname,"\n")};
        my $rrdfile = $rrdpath."\/".$rrdname;
        unless (-e $rrdfile)
        {
            RRDs::create ($rrdfile,"DS:value:COUNTER:".(($_*60)+600).":0:10000000000","RRA:AVERAGE:0.5:1:365","RRA:AVERAGE:0.5:7:300","-s ".($_*60));
        }
        my $countervalue = int($value*$_*60);
        RRDs::update("$rrdfile", "N:$countervalue");
    }
}

sub rrd_gauge
{
    if ($debug==1){print ("GAUGE","\n")};
    my $obisname = $_[0];
    if ($debug==1){print $obisname." obisname \n";}
    my $value = $_[1];
    if ($debug==1){print $value." value \n";}
    my $rrdname = $obisname."\.rrd";
    if ($debug==1){print ($rrdname,"\n")};
    my $rrdfile = $rrdpath."\/".$rrdname;
    unless (-e $rrdfile)
    {
        RRDs::create ($rrdfile,"DS:value:GAUGE:900:0:10000000000","RRA:AVERAGE:0.5:1:2160","RRA:AVERAGE:0.5:5:2016","RRA:AVERAGE:0.5:15:2880","RRA:AVERAGE:0.5:60:8760");
    }
    RRDs::update("$rrdfile", "N:$value");
}


sub knx_write {
    my ($dst,$value,$dpt,$response,$dbgmsg) = @_;
    my $bytes;
    my $apci = ($response) ? 0x40 : 0x80; # 0x40=response, 0x80=write
    #     DPT 1 (1 bit) = EIS 1/7 (move=DPT 1.8, step=DPT 1.7)
    #     DPT 2 (1 bit controlled) = EIS 8
    #     DPT 3 (3 bit controlled) = EIS 2
    #     DPT 4 (Character) = EIS 13
    #     DPT 5 (8 bit unsigned value) = EIS 6 (DPT 5.1) oder EIS 14.001 (DPT 5.10)
    #     DPT 6 (8 bit signed value) = EIS 14.000
    #     DPT 7 (2 byte unsigned value) = EIS 10.000
    #     DPT 8 (2 byte signed value) = EIS 10.001
    #     DPT 9 (2 byte float value) = EIS 5
    #     DPT 10 (Time) = EIS 3
    #     DPT 11 (Date) = EIS 4
    #     DPT 12 (4 byte unsigned value) = EIS 11.000
    #     DPT 13 (4 byte signed value) = EIS 11.001
    #     DPT 14 (4 byte float value) = EIS 9
    #     DPT 15 (Entrance access) = EIS 12
    #     DPT 16 (Character string) = EIS 15
    # $dpt = $eibgaconf{$dst}{'DPTSubId'} unless $dpt; # read dpt from eibgaconf if existing
    given ($dpt) {
        when (/^12/)             { $bytes = pack ("CCL>", 0, $apci, $value); }  #EIS11.000/DPT12 (4 byte unsigned)
        when (/^13/)             { $bytes = pack ("CCl>", 0, $apci, $value); }
        when (/^14/)             { $bytes = pack ("CCf>", 0, $apci, $value); }
        when (/^16/)             { $bytes = pack ("CCa14", 0, $apci, $value); }
        when (/^17/)             { $bytes = pack ("CCC", 0, $apci, $value & 0x3F); }
        when (/^20/)             { $bytes = pack ("CCC", 0, $apci, $value); }
        when (/^\d\d/)           { return; } # other DPT XX 15 are unhandled
        when (/^[1,2,3]/)        { $bytes = pack ("CC", 0, $apci | ($value & 0x3f)); } #send 6bit small
        when (/^4/)              { $bytes = pack ("CCc", 0, $apci, ord($value)); }
        when ([5,5.001])         { $bytes = pack ("CCC", 0, $apci, encode_dpt5($value)); } #EIS 6/DPT5.001 1byte
        when ([5.004,5.005,5.010]) { $bytes = pack ("CCC", 0, $apci, $value); }
        when (/^5/)              { $bytes = pack ("CCC", 0, $apci, $value); }
        when (/^6/)              { $bytes = pack ("CCc", 0, $apci, $value); }
        when (/^7/)              { $bytes = pack ("CCS>", 0, $apci, $value); }
        when (/^8/)              { $bytes = pack ("CCs>", 0, $apci, $value); }
        when (/^9/)              { $bytes = pack ("CCCC", 0, $apci, encode_dpt9($value)); } #EIS5/DPT9 2byte float
        default                  { LOGGER('WARN',"None or unsupported DPT: $dpt sent to $dst value $value"); return; }
    }
    my $leibcon = EIBConnection->EIBSocketURL($eib_url) or return("Error opening con: $!");
    if ($leibcon->EIBOpenT_Group(str2addr($dst),1) == -1) { return("Error opening group: $!"); }
    my $res=$leibcon->EIBSendAPDU($bytes);
    $leibcon->EIBClose();
    return $res;
    
    # str2addr: Convert an EIB address string in the form "1/2/3" or "1.2.3" to an integer
    sub str2addr {
        my $str = $_[0];
        if ($str =~ /(\d+)\/(\d+)\/(\d+)/) { # logical address
            return ($1 << 11) | ($2 << 8) | $3;
        } elsif ($str =~ /(\d+)\.(\d+)\.(\d+)/) { # physical address
            return ($1 << 12) | ($2 << 8) | $3;
        } else {
            #bad
            return;
        }
    }
    
}

sub encode_dpt9
{
    # 2byte signed float
    my $state = shift;
    my $data;
    my $sign = ($state <0 ? 0x8000 : 0);
    my $exp  = 0;
    my $mant = 0;
    $mant = int($state * 100.0);
    while (abs($mant) > 2047)
    {
        $mant /= 2;
        $exp++;
    }
    $data = $sign | ($exp << 11) | ($mant & 0x07ff);
    return $data >> 8, $data & 0xff;
}

Einen Kommentar schreiben:

JuMi2006 antwortet

11.03.2013, 22:20
Eben nochmal geändert, sollte eigentlich so jetzt richtig sein.
Du hättest in @obis noch die 0F.0.7 in 15.0.7 ändern müssen.

Grüße
Einen Kommentar schreiben:
lio123 antwortet

11.03.2013, 22:13
Hallo,

für meine Werte zum Testen habe ich die Obis Zeilen von Mirko übernommen.
Hier wurden die Werte ja richtig angezeigt.
Die Subs habe ich ebenfalls rauskopiert, tty und GA angepasst.

Der Verbrauch wird richtig angezeigt, aber bei Leistung steht -0.1 ???

wüsste jetzt nicht woran das liegen könnte.

Grüße,
Lio
Einen Kommentar schreiben:

JuMi2006 antwortet

11.03.2013, 21:54

Damit sollte der Workaround für 15.0.7 nicht mehr nötig sein.
Schön dass es sich entwickelt!

Grüße

Code:

#!/usr/bin/perl

use warnings;
use strict;
use Device::SerialPort;
use feature "switch";
use EIBConnection;
use RRDs;
use Fcntl qw(:DEFAULT :flock);


#0701000F0700FF = 15.7.0
#070100010801FF = 1.8.1
#070100010800FF = 1.8.1

# Lock setzen damit Skript nur einmal startet


  open  *{0}
        or die "What!? $0:$!";
  flock *{0}, LOCK_EX|LOCK_NB
    or die "$0 is already running somewhere!\n";


my $eib_url = "ip:rk_nas";     #for local eibd "local:/tmp/eib" for eibd in LAN: "ip:192.168.2.220:6720"
my $device = "/dev/ttyUSB0";
my $repeat = 20;   # Wiederholung alle x Sekunden
my $rrdpath = "/var/www/rrd";
my $debug = 0;

my @obis;

push @obis,{obis=>"1.8.2",  fact=>10000, ga =>"5/5/5", dpt => 14, rrd_name => "Zaehlerstand", rrd => "c"   }; #rrd: c=counter ; g=gauge
push @obis,{obis=>"15.7.0",    fact=>10,    ga =>"5/5/6", dpt => 14 , rrd_name => "Zaehler_Leistung",  rrd => "g" };


my @countermodes = (5,15,60,1440);    #Aufloesungen fuer COUNTER RRDs in Minuten (1440 = Tagesverbrauch)


my $port = Device::SerialPort->new($device) || die $!;

$port->databits(8) || die "failed setting databits";
$port->baudrate(9600) || die "failed setting baudrate";
$port->parity("none") || die "failed setting parity";
$port->stopbits(1);
$port->handshake("none");
$port->dtr_active(0);
$port->purge_all();
$port->read_char_time(0);     # don't wait for each character
$port->read_const_time(4000); # 1 second per unfulfilled "read" call
$port->write_settings || die "cannot write settings";


# Loop zum Datenempfang

my $error=0;

while ($error != 1)
{

   my ($x,$data) = 0 ;
   my $sml = 0;
   my $start = 0;
   my $value = 0;
   my $dec_value = 0;
   my $count = 0;
   my $saw = 0;

   if ($debug == 1) {print "Step 1 - Daten holen \n";}

   while ($start < 2)  # wait for second 1B1B1B1B01010101
     {
      ($count,$saw)=$port->read(512);   # will read 512 chars
      if ($count == 512)       # wurden 512 chars gelesen ?
        {
         $x = uc(unpack('H*',$saw)); # nach hex wandeln
         $data .= $x;
         if ($data =~ /1B1B1B1B01010101/)  {$start ++};
        } # if
     }  # while

   if ($debug==1) {print "Step 2 - Reg Exp 1 Datensatz zusammensetzen \n";}
   $data =~ m/1B1B1B1B01010101(.*?)B1B1B1/;
   $sml = $1;

   print "Zaehler Haushalt: \n";

   if ($debug==1) {print "Step 3 - Datensatz auswerten \n";}

   foreach my $obiscnt (@obis)
    {
     # Umwandeln OBIS in HEx
[COLOR="Red"]my $hc ="";
foreach my $c (split(/\./,$obiscnt->{obis})) {
$hc .= sprintf("%02X", $c);
}
my $obissearch = $hc;[/COLOR]
     # FF fuer Suche an  Hex-Wert anhaegne
     $obissearch .="FF";
     if ($debug==1) { print $obissearch."     Obis\n";}
     $sml =~ m/$obiscnt->{obis}(.*?)0177/;
     my $sml_val = $1;

     if ($debug==1)  {  print $1." contains hex \n";}

     #extract value
     $sml_val =~ s/^.*52FF//;
     $sml_val = substr($sml_val,2);
     if ($debug == 1) {  print $sml_val." hex \n";}
     $value = $sml_val;

     $dec_value = sprintf("%d", hex($value));
     $dec_value /= $obiscnt->{fact};
     print $dec_value."<<<<---- Wert\n";

     #  RRD-Graphen erstellen  - bei Bedarf wieder aktiv setzen
     #if ($obis->{rrd} eq "c")
     #   {
     #   &rrd_counter ($obis->{rrd_name},$dec_value)
     #   }
     #if ($obis->{rrd} eq "g")
     #   {
     #   &rrd_gauge ($obis->{rrd_name},$dec_value)
     #   }

     &knx_write ($obiscnt->{ga},$dec_value,$obiscnt->{dpt});
     if ($debug == 1) {print "GA:".$obiscnt->{ga}." Wert:".$dec_value." DPT:".$obiscnt->{dpt}."\n";}

    } # foreach

    sleep $repeat;

} # while

$port->close() || warn "Serial port did not close proper!\n";
undef $port;

### SUBS ###

sub rrd_counter {}  # wie gehabt
sub rrd_gauge {}  # wie gehabt
sub knx_write {}  # wie gehabt

Einen Kommentar schreiben:

gklein antwortet

11.03.2013, 20:14

Hi,

das angepasste Perl-Script hat quasi 24 Stunden überstanden. Hier der geänderte Code:

Code:

#!/usr/bin/perl

use warnings;
use strict;
use Device::SerialPort;
use feature "switch";
use EIBConnection;
use RRDs;
use Fcntl qw(:DEFAULT :flock);


#0701000F0700FF = 7.0       FIXME !!! [0F]0700
#070100010801FF = 1.8.1
#070100010800FF = 1.8.1

# Lock setzen damit Skript nur einmal startet


  open  *{0}
        or die "What!? $0:$!";
  flock *{0}, LOCK_EX|LOCK_NB
    or die "$0 is already running somewhere!\n";


my $eib_url = "ip:rk_nas";     #for local eibd "local:/tmp/eib" for eibd in LAN: "ip:192.168.2.220:6720"
my $device = "/dev/ttyUSB0";
my $repeat = 20;   # Wiederholung alle x Sekunden
my $rrdpath = "/var/www/rrd";
my $debug = 0;

my @obis;

push @obis,{obis=>"1.8.2",  fact=>10000, ga =>"5/5/5", dpt => 14, rrd_name => "Zaehlerstand", rrd => "c"   }; #rrd: c=counter ; g=gauge
# Workaround fuer 15.7.0 - aktuellen Verbrauch
push @obis,{obis=>"F.7.0",    fact=>10,    ga =>"5/5/6", dpt => 14 , rrd_name => "Zaehler_Leistung",  rrd => "g" };


my @countermodes = (5,15,60,1440);    #Aufloesungen fuer COUNTER RRDs in Minuten (1440 = Tagesverbrauch)


my $port = Device::SerialPort->new($device) || die $!;

$port->databits(8) || die "failed setting databits";
$port->baudrate(9600) || die "failed setting baudrate";
$port->parity("none") || die "failed setting parity";
$port->stopbits(1);
$port->handshake("none");
$port->dtr_active(0);
$port->purge_all();
$port->read_char_time(0);     # don't wait for each character
$port->read_const_time(4000); # 1 second per unfulfilled "read" call
$port->write_settings || die "cannot write settings";


# Loop zum Datenempfang

my $error=0;

while ($error != 1)
{

   my ($x,$data) = 0 ;
   my $sml = 0;
   my $start = 0;
   my $value = 0;
   my $dec_value = 0;
   my $count = 0;
   my $saw = 0;

   if ($debug == 1) {print "Step 1 - Daten holen \n";}

   while ($start < 2)  # wait for second 1B1B1B1B01010101
     {
      ($count,$saw)=$port->read(512);   # will read 512 chars
      if ($count == 512)       # wurden 512 chars gelesen ?
        {
         $x = uc(unpack('H*',$saw)); # nach hex wandeln
         $data .= $x;
         if ($data =~ /1B1B1B1B01010101/)  {$start ++};
        } # if
     }  # while

   if ($debug==1) {print "Step 2 - Reg Exp 1 Datensatz zusammensetzen \n";}
   $data =~ m/1B1B1B1B01010101(.*?)B1B1B1/;
   $sml = $1;

   print "Zaehler Haushalt: \n";

   if ($debug==1) {print "Step 3 - Datensatz auswerten \n";}

   foreach my $obiscnt (@obis)
    {
     # Umwandeln OBIS in HEx-Wert
     my $obissearch = $obiscnt->{obis};
     $obissearch =~ s/\./0/g;
     # FF fuer Suche an  Hex-Wert anhaegne
     $obissearch .="FF";
     if ($debug==1) { print $obissearch."     Obis\n";}
     $sml =~ m/$obiscnt->{obis}(.*?)0177/;
     my $sml_val = $1;

     if ($debug==1)  {  print $1." contains hex \n";}

     #extract value
     $sml_val =~ s/^.*52FF//;
     $sml_val = substr($sml_val,2);
     if ($debug == 1) {  print $sml_val." hex \n";}
     $value = $sml_val;

     $dec_value = sprintf("%d", hex($value));
     $dec_value /= $obiscnt->{fact};
     print $dec_value."<<<<---- Wert\n";

     #  RRD-Graphen erstellen  - bei Bedarf wieder aktiv setzen
     #if ($obis->{rrd} eq "c")
     #   {
     #   &rrd_counter ($obis->{rrd_name},$dec_value)
     #   }
     #if ($obis->{rrd} eq "g")
     #   {
     #   &rrd_gauge ($obis->{rrd_name},$dec_value)
     #   }

     &knx_write ($obiscnt->{ga},$dec_value,$obiscnt->{dpt});
     if ($debug == 1) {print "GA:".$obiscnt->{ga}." Wert:".$dec_value." DPT:".$obiscnt->{dpt}."\n";}

    } # foreach

    sleep $repeat;

} # while

$port->close() || warn "Serial port did not close proper!\n";
undef $port;

### SUBS ###

sub rrd_counter {}  # wie gehabt
sub rrd_gauge {}  # wie gehabt
sub knx_write {}  # wie gehabt

Einen Kommentar schreiben:

gklein antwortet

11.03.2013, 09:14
Hi Lio,

ja, ist immer noch das gleiche Thema. Ich möchte meinen ED300L auslesen, der spricht ja SML.
Das neue Script scheint das Problem zu lösen, hat die ganze Nacht anstandslos Daten geliefert. Ich mach das mal schick, dann stell ich es hier ein.

Grüße
Gunnar
Einen Kommentar schreiben:

Vorherige 1 4 11 12 13 14 15 16 17 24 35 template Weiter

Ankündigung

Zählerabfrage als Wiregate Plugin

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben:

Einen Kommentar schreiben: