Kontinuierlich Net-Stream anzeigen (Allgemeines zu Perl)

[thread]16898[/thread]

Kontinuierlich Net-Stream anzeigen

Tags: perl5 Ähnliche Threads

Leser: 25

Articles: hide open all | hide show old branches

+30 replies

kami

2011-11-09 13:05

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hallo

ich habe hier einen MAX! Cube stehen, der hat auf dem Port 80 kontinuierlich einen neuen Datensatz vorliegen. Ich möchte nun immer wieder diesen Auslesen und Arbeiten. Dafür habe ich auch schon einen PHP-Quellcode. Dieser erledigt bei einmaligen Aufruf die richtige Umsetzung und Ausgabe. Das Resultat des Test ist eine "0" oder "1".

more (6.4kb)

Nun möchte ich das kontinuierlich durch PERL in der Console erledigen lassen. Hier habe ich aber auch schon das erste Problem. Ich kriege trotz while-Schleife nur einmal den Datensatz angezeigt. Wie kann ich die Ausgabe immer wieder bekommen?
Hat vielleicht jemand lust mir das PHP-Skript in ein PERL-Skript umzuschreiben? Vielen dank für Hilfe.

Code (perl): (dl )

#!/usr/bin/perl -w
    use strict;
    use IO::Socket;
 $| = 1;
    my ($host, $port, $kidpid, $handle, $line);

    unless (@ARGV == 2) { die "usage: $0 host port" }
    ($host, $port) = @ARGV;
    
    # create a tcp connection to the specified host and port
    $handle = IO::Socket::INET->new(Proto     => "tcp",
                                    PeerAddr  => $host,
                                    PeerPort  => $port)
           or die "can't connect to port $port on $host: $!";
     while () {
    #$handle->autoflush(1);             # so output gets there right away
   # print STDERR "[Connected to $host:$port]\n";

    # the if{} block runs only in the parent process

        # copy the socket to standard output
        $line = <$handle> ;
            print STDOUT $line;
        
        
    }

Gruß kami

modedit Editiert von GwenDragon: Langes PHP-Listing im More-Tags
Last edited: 2011-12-01 18:35:32 +0100 (CET)

+2 replies
kami

2011-11-09 16:59

User since
2010-03-17
92 Artikel
BenutzerIn

Keiner einen Tipp?

Gruß kami
- Linuxer
  
  2011-11-09 17:27
  
  User since
  2006-01-27
  3890 Artikel
  HausmeisterIn
  
  Naja, das ist schon ein gutes Stück Code (jedenfalls der PHP-Teil). Das schreckt erstmal ab, da mal eben nachzuschauen. Das kostet Zeit, das nachzuvollziehen, was da passieren soll, etc. Die Zeit muss man erstmal haben, bzw. sich erstmal nehmen.
  
  meine Beiträge: I.d.R. alle Angaben ohne Gewähr und auf Linux abgestimmt!
  Die Sprache heisst Perl, nicht PERL. - Bitte Crossposts als solche kenntlich machen!
pq

2011-11-09 17:10

User since
2003-08-04
12208 Artikel
Admin1

nur so als tip, die sprache heisst Perl und nicht PERL =)
und wenn du möchtest, dass sich jemand mit dem code beschäftigt, wäre es ratsam, den etwas lebarer zu machen, die zeilen sind viel zu lang.
Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live. -- Damian Conway in "Perl Best Practices"
lesen: Wie frage ich & perlintro brian's Leitfaden für jedes Perl-Problem

rosti

2011-11-09 21:16

User since
2011-03-19
3492 Artikel
BenutzerIn

Was sagt denn das Protokoll, muss da erst ein Request gesendet werden und kommt dann die Antwort als Endlos-Stream oder kommt da was Endliches? Oder gehst Du auf das Socket und liest nur den Stream aus (like NTP)?

Port 80 sieht jedenfalls für mich aus wie http oder rtsp. Ein Ripper sähe in etwa so aus (mp3-Stream mitschneiden):

Code (perl): (dl )

# socket handle erstellen
my $socket = new IO::Socket::INET (
        PeerAddr => $host,
        PeerPort => $port,
        Proto    => 'tcp'
);

# Request Header senden
print $socket "GET / HTTP/1.0\n\n";

# Speicherort des Streams öffnen
open(OUT, ">cut.mp3");
binmode OUT;
while(my $s = read($socket, my $buffer, 1024)){
        print OUT $buffer;
}

Edit:

Code (perl): (dl )

my $socket = new IO::Socket::INET("$host:$port"); # kurzform

Last edited: 2011-11-09 21:27:08 +0100 (CET)

+25 replies

topeg

2011-11-10 00:20

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Eine Umsetzung als in Perl (ohne es getestet zu haben):

more (31.7kb)

Aber einiges an dem PHP Code kommt mir seltsam vor. Scheint etwas gebastelt zu sein...

Edit:
Ich vermute, dass die Verbindung geschlossen wird, wenn alle Daten gesendet sind. In den Fall muss die Verbindung immer wieder neu aufgebaut werden. (siehe Code)
Last edited: 2011-11-10 00:27:43 +0100 (CET)

+24 replies

kami

2011-11-10 11:08

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hallo,

erstmal super vielen Dank für die ganze Hilfe und die Tipps.
Das Skript sieht ja schon sehr gut aus. Leider bekomme ich sofort beim ausführen folgenden Fehler:

Can't locate object method "binmode" via package "IO::Socket::INET" at ./pler.pl line 21.

Kann mir einer dazu weiterhelfen?

Gruß kami

+23 replies

Gast wer

2011-11-10 11:52

Mach mal anstatt
$handle->binmode();
binmode($handle);
Last edited: 2011-11-10 12:07:28 +0100 (CET)

+22 replies

kami

2011-11-10 13:07

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi,

also ich kriege mit dem Skript nun folgenden Output:

No Connection
ERROR open Socket 192.168.1.2:80 (Verbindungsaufbau abgelehnt)

Damit habe ich nun mal getestet und rausgefunden, das er zwar connected aber die erste Schleife

while(my $line=$handle->getline() && time() < $time+20 && $finished==0)

nicht aufgerufen wird. Kann ja eigentlich nur an getline() liegen? Wie kann man das anpassen?

Gruß kami

P.S.: weiteres Testen hat ergeben der Inhalt von $line ist immer nur "1" und die schleife läuft so oft durch wie es Zeilen im Telegram gibt. Danach ist schluss.
Last edited: 2011-11-10 13:24:02 +0100 (CET)

+2 replies

Gast wer

2011-11-10 13:45

mach mal:

Code (perl): (dl )

  my $buffer='';
  my $line='';
  while(defined($line) && time() < $time+20 && $finished==0)
  {
    $handle->read($line,4096);
    $finished=1 if(index($buffer,'L:')!=-1);
    $buffer.=$line if(defined($line) && length($line));
  }

Last edited: 2011-11-10 13:49:38 +0100 (CET)

kami

2011-11-10 14:15

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Okay,

also jetzt ist der buffer zwar mit dem Stream kontinuierlich gefüllt. Aber jedes Zeile des Telegrams ist zigmal da drin. Das heißt ich habe nicht :

Code: (dl )

H:IEQ0111347,00b5b6,0102,00000000,3ed09189,01,32
M:00,01,VgICAQpXb2huemltbWVyAQhjAgZLw7xjaGUAjwIFAQEIY0lFUTAxOTI4MDcKV29obnppbW1lcgEEAFv7SUVRMDE1Njg3NwtXb2huZmVuc3RlcgEFAEu4SUVRMDE0NTQ4OQxFQ08tU2NoYWx0ZXIAAQCPAklFUTAxOTU0NzUGS8O8Y2hlAgQAX9ZJRVEwMTU3Nzc2DUZlbnN0ZXJrw7xjaGUCAQ==
C:00b5b6,7QC1tgACAf9JRVEwMTExMzQ3AQsABEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAsABEAAAAAAAAAAQQAAAAAAAAAAAAAAAAAAAAAAAAAAAGh0A6Ly9zcGFycGFrZXQtaGVpenVuZy5ld2UuZGU6ODAvY3ViZQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAENFVAAACgADEA4AAENFU1QAAwAAIBwAAA==
C:005fd6,EQBf1gQAEw9JRVEwMTU3Nzc2
C:008f02,0gCPAgECFP9JRVEwMTk1NDc1Lh49CQcYA3AM/wA8dVycPNVc9j0gPSA9IEUgRSBFIEUgRSBFIDx1XJw8zFztPSA9ID0gRSBFIEUgRSBFIEUgPSA9ID0gPSA9ID0gPSBFIEUgRSBFIEUgRSA9ID0gPSA9ID0gPSA9IEUgRSBFIEUgRSBFID0gPSA9ID0gPSA9ID0gRSBFIEUgRSBFIEUgPSA9ID0gPSA9ID0gPSBFIEUgRSBFIEUgRSA9ID0gPSA9ID0gPSA9IEUgRSBFIEUgRSBFIA==
C:004bb8,EQBLuAUAEg9JRVEwMTQ1NDg5
C:005bfb,EQBb+wQAEw9JRVEwMTU2ODc3
C:010863,0gEIYwEBFP9JRVEwMTkyODA3Lh49CQcYA3AM/wA8dVycPNVc9j0gPSA9IEUgRSBFIEUgRSBFIDxyXQg9ID0gPSA9ID0gRSBFIEUgRSBFIEUgPNhdCD0gPSA9ID0gPSBFIEUgRSBFIEUgRSA82F0IPSA9ID0gPSA9IEUgRSBFIEUgRSBFIDzYXQg9ID0gPSA9ID0gRSBFIEUgRSBFIEUgPNhdCD0gPSA9ID0gPSBFIEUgRSBFIEUgRSA82F0IPSA9ID0gPSA9IEUgRSBFIEUgRSBFIA==
L:BgBf1gASEAsAjwIAEhkJHgCtAAYAS7gAEhAGAFv7ABIQCwEIYwASGRoeALAA

Sondern:

Code: (dl )

H:IEQ0111347,00b5b6,0102,00000000,3ed09189,01,32
H:IEQ0111347,00b5b6,0102,00000000,3ed09189,01,32
H:IEQ0111347,00b5b6,0102,00000000,3ed09189,01,32
H:IEQ0111347,00b5b6,0102,00000000,3ed09189,01,32
H:IEQ0111347,00b5b6,0102,00000000,3ed09189,01,32
H:IEQ0111347,00b5b6,0102,00000000,3ed09189,01,32
M:00,01,VgICAQpXb2huemltbWVyAQhjAgZLw7xjaGUAjwIFAQEIY0lFUTAxOTI4MDcKV29obnppbW1lcgEEAFv7SUVRMDE1Njg3NwtXb2huZmVuc3RlcgEFAEu4SUVRMDE0NTQ4OQxFQ08tU2NoYWx0ZXIAAQCPAklFUTAxOTU0NzUGS8O8Y2hlAgQAX9ZJRVEwMTU3Nzc2DUZlbnN0ZXJrw7xjaGUCAQ==
M:00,01,VgICAQpXb2huemltbWVyAQhjAgZLw7xjaGUAjwIFAQEIY0lFUTAxOTI4MDcKV29obnppbW1lcgEEAFv7SUVRMDE1Njg3NwtXb2huZmVuc3RlcgEFAEu4SUVRMDE0NTQ4OQxFQ08tU2NoYWx0ZXIAAQCPAklFUTAxOTU0NzUGS8O8Y2hlAgQAX9ZJRVEwMTU3Nzc2DUZlbnN0ZXJrw7xjaGUCAQ==
M:00,01,VgICAQpXb2huemltbWVyAQhjAgZLw7xjaGUAjwIFAQEIY0lFUTAxOTI4MDcKV29obnppbW1lcgEEAFv7SUVRMDE1Njg3NwtXb2huZmVuc3RlcgEFAEu4SUVRMDE0NTQ4OQxFQ08tU2NoYWx0ZXIAAQCPAklFUTAxOTU0NzUGS8O8Y2hlAgQAX9ZJRVEwMTU3Nzc2DUZlbnN0ZXJrw7xjaGUCAQ==
M:00,01,VgICAQpXb2huemltbWVyAQhjAgZLw7xjaGUAjwIFAQEIY0lFUTAxOTI4MDcKV29obnppbW1lcgEEAFv7SUVRMDE1Njg3NwtXb2huZmVuc3RlcgEFAEu4SUVRMDE0NTQ4OQxFQ08tU2NoYWx0ZXIAAQCPAklFUTAxOTU0NzUGS8O8Y2hlAgQAX9ZJRVEwMTU3Nzc2DUZlbnN0ZXJrw7xjaGUCAQ==
M:00,01,VgICAQpXb2huemltbWVyAQhjAgZLw7xjaGUAjwIFAQEIY0lFUTAxOTI4MDcKV29obnppbW1lcgEEAFv7SUVRMDE1Njg3NwtXb2huZmVuc3RlcgEFAEu4SUVRMDE0NTQ4OQxFQ08tU2NoYWx0ZXIAAQCPAklFUTAxOTU0NzUGS8O8Y2hlAgQAX9ZJRVEwMTU3Nzc2DUZlbnN0ZXJrw7xjaGUCAQ==
....l

Gruß kami

+19 replies

topeg

2011-11-10 16:34

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Ja da ist ein Fehler drin. && hat eine zu hohe Priorität und wird vor der Zuweisung "=" ausgeführt
Lösung:

Code (perl): (dl )

while(( my $line=$handle->getline() ) && time() < $time+20 && $finished==0)

oder

Code (perl): (dl )

while(( my $line=<$handle> ) && time() < $time+20 && $finished==0)

oder

Code (perl): (dl )

while( my $line=<$handle> and time() < $time+20 and $finished==0)

+18 replies

kami

2011-11-10 18:38

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi,

das klappt leider auch nicht nun ist der $buffer immer leer.

Gruß kami

So sieht das Skript jetzt aus:

Code (perl): (dl )

#!/usr/bin/perl
use strict;
use warnings;

use IO::Socket;
use MIME::Base64;

my $host = "192.168.1.36"; # Your Cube-IP or hostame Here!
my $port = "80";


 # ewige schleife
while(1)
{

  my $handle = IO::Socket::INET->new(
          Proto     => "tcp",
          PeerAddr  => $host,
          PeerPort  => $port
        ) // die("ERROR open Socket $host:$port ($!)\n");

  $handle->blocking(0);
  binmode($handle);

  my $finished = 0;
  my $time=time();

  
my $buffer='';
my $line='';
  while(( my $line=$handle->getline() ) && time() < $time+20 && $finished==0)
  {
    $handle->read($line,4096);
    $finished=1 if(index($buffer,'L:')!=-1);
    $buffer.=$line if(defined($line) && length($line));
    
  }

  $handle->close();
  print "test:";
  print $buffer;
print "ende"; 
  if(!$finished)
  {
    print "No Connection\n";
    next;
  }

  my %data;
  my %deviceconf;

  for my $v (split("\n\n",$buffer))
  {
    if($v=~/^M:(?:[^,]*,){2}([^,]+)/)
    {
      my $str=decode_base64($1);
      $data{meta}{'?1'}=substr_hex(\$str,1);
      $data{meta}{'?2'}=substr_hex(\$str,1);
      $data{meta}{RoomCount}=substr_ord(\$str,1);


      for(1..$data{meta}{RoomCount})
      {
        my $roomid=substr_hex(\$str,1);
        my $name_length=substr_ord(\$str,1);
        #$data{rooms}{$roomid}{RoomNameLength}=$name_length;
        $data{rooms}{$roomid}{RoomName}=substr_del(\$str,$name_length);

        # TODO: Nachprüfen!!!!
        $data{rooms}{$roomid}{"RFAdress(?)"}=substr_hex_fix(\$str,3);
      }

      $data{meta}{DevCount}=substr_ord(\$str,1);
    }

    if($v=~/^L:(.+)/)
    {
      my %hilf;
      my $str=decode_base64($1);
      for(1..$data{meta}{DevCount})
      {
        my $length=substr_ord(\$str,1);
        #$hilf{ReadLength}=$length;

        # TODO: Nachprüfen!!!!
        $hilf{RFAdress}=substr_hex_fix(\$str,3);

        $hilf{'?1'}=substr_hex(\$str,1);
        $hilf{Data1}=substr_bin(\$str,1);
        $hilf{Data2}=substr_bin(\$str,1);

        if($length == 11)
        {
          $hilf{'?2'}=substr_hex(\$str,1);
          $hilf{Temperature}=substr_ord(\$str,1)/2;
          $hilf{DateUntil}=substr_bin(\$str,1);
          $hilf{TimeUntil}=substr_ord(\$str,1)/2;
        }

        my $sub=substr($hilf{Data2},6,2);
        if($sub eq '00')
        { $deviceconf{$hilf{RFAdress}}{Mode} = 'auto' }
        elsif($sub eq '01')
        { $deviceconf{$hilf{RFAdress}}{Mode} = 'manu' }
        elsif($sub eq '10')
        { $deviceconf{$hilf{RFAdress}}{Mode} = 'vacation' }
        else
        { $deviceconf{$hilf{RFAdress}}{Mode} = 'boost' }

        $deviceconf{$hilf{RFAdress}}{LiveDataX} = $hilf{Data3};
      }
    }
  }

  if ($deviceconf{'005bfb'}{Mode} eq 'auto' && $deviceconf{'004bb8'}{Mode} eq 'auto' )
  { print  $deviceconf{'005bfb'}{Mode}; }
  else
  { print $deviceconf{'005bfb'}{Mode}; }

  sleep(10);
}

########################################################################
sub substr_del { return substr( ${$_[0]}, 0, $_[1], '') }
sub substr_ord { return unpack('C*', substr_del(@_) ); }
sub substr_hex { return unpack('H*', substr_del(@_)); }

# TODO: Nachprüfen!!!!
sub substr_hex_fix {
  my $str=shift;
  my $length=shift;
  my $ret='';
  $ret.=substr("00".substr_hex($str,1),-2,2) for(1..$length);
  return $ret;
}


# TODO: Nachprüfen!!!!
sub substr_bin { return substr(("0"x8).unpack('B*', substr_del(@_)),-8,8); }

Last edited: 2011-11-10 18:41:48 +0100 (CET)

+17 replies

topeg

2011-11-10 19:23

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

wenn das nicht funktioniert dann weiß ich auch nicht:

Code (perl): (dl )

  my $finished = 0;
  my $time=time();
  my $buffer='';
  while(time() < $time+20 && $finished==0)
  {
    my $line='';
    $handle->read($line,4096);
    $finished=1 if(index($buffer,'L:')!=-1);
    $buffer.=$line if(length($line));
  }

getestet mit dem Server:
more (9.7kb)

+16 replies

kami

2011-11-10 21:53

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi, klappt jetzt super.

Vielen Dank.

Nur die Entschlüsselung muss ich noch hinkriegen.

Aber das schaue ihc mir morgen mal an.

Gruß kami
Last edited: 2011-11-10 22:00:12 +0100 (CET)

+15 replies

kami

2011-11-23 16:31

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi Leute,

so ich bin nun etwas weiter mit meinem Skript. Das verbinden klappt alles super und ich kriege die Daten immer wieder in da File test geschrieben. Da ich es noch nicht geschafft habe die Umwandlung zu portieren, muss ich mit dem PHP-Skript alwindow.php auf das File test zu greifen und bei Bedarf eine Auswertung machen. Ich habe nun noch folgende 2 Probleme:
1. Wenn das Skript pler.pl läuft dann benötigt es sehr viel Rechenleistung. Kann man das irgendwie optimieren oder verschlanken?
2. Kann man die Entschlüsselung irgendwie in Perl portieren? Mit der Version von topeg, gab es dort leider nur Fehler.

Vielen Dank.

Gruß kami

Code (perl): (dl )

#!/usr/bin/perl -w
use strict;
use warnings;

use IO::Socket;

my $host = "192.168.0.36"; # Your Cube-IP or hostame Here!
my $port = "80";

while(1)
{

  my $handle = IO::Socket::INET->new(
          Proto     => "tcp",
          PeerAddr  => $host,
          PeerPort  => $port
        ) // die("ERROR open Socket $host:$port ($!)\n");

  $handle->blocking(0);
  binmode($handle);

  my $finished = 0;
 
  my $buffer='';
  while($finished==0)
  {
    my $line='';
    $handle->read($line,4096);
    $finished=1 if(index($buffer,'L:')!=-1);
    $buffer.=$line if(length($line));
    
  }

  $handle->close();

  if(!$finished)
  {
    print "No Connection\n";
    next;
  }


  open(STATION, ">/home/kami/scripts/test");
  foreach  my $v (split("\r",$buffer))
  {
     print STATION $v."\n";
   }
   close (STATION);
   sleep(3);
   system("./alwindow.php", "windowsstatus");
   print $?;
   
}

alwindow.php:

Code: (dl )

 
#!/usr/bin/php -q
<?php

#print_r($argv);
$finished = 0;
 
$jetzt = time();


$handle = @fopen('/home/kami/scripts/test', "r");
if ($handle) {
   while (!feof($handle)) {
       $arr[] = fgets($handle, 4096);
   }
   fclose($handle); 
   }
ob_start();   
foreach ($arr as $v)
{

if (substr($v,0,2) == "M:")
{
$arr2 = explode(',',$v);
$str = base64_decode($arr2[2]);
 
$pos = 0;
$readlen =  1; $data["meta"]["?1"] = dechex(ord(substr($str,$pos,1)))."";  $pos += $readlen;
$readlen =  1; $data["meta"]["?2"] = dechex(ord(substr($str,$pos,1)))."";  $pos += $readlen; 
$readlen =  1; $data["meta"]["RoomCount"] = dechex(ord(substr($str,$pos,1)))."";  $pos += $readlen;


for($j = 1 ; $j <= $data["meta"]["RoomCount"] ; $j++)
{
$readlen =            1;  $RoomID = dechex(ord(substr($str,$pos,1)))."";  $pos += $readlen;
$readlen =            1;  $data["rooms"][$RoomID]["RoomNameLength"] = htmlentities(ord(substr($str,$pos,1))).""; $pos += $readlen;
$readlen = $data["rooms"][$RoomID]["RoomNameLength"];  for($i = $pos; $i < $readlen+$pos ; $i++) $data["rooms"][$RoomID]["RoomName"] .= htmlentities(substr($str,$i,1)).""; $pos += $readlen;
$readlen =            3;  for($i = $pos; $i < $readlen+$pos ; $i++) $data["rooms"][$RoomID]["RFAdress(?)"] .= str_pad(dechex(ord(substr($str,$i,1))),2,"0",STR_PAD_LEFT)."";  $pos += $readlen;
}

$readlen =            1; $data["meta"]["DevCount"] = dechex(ord(substr($str,$pos,1))).""; $pos += $readlen;




}

 
if (substr($v,0,2) == "L:")
{
$v = substr($v,2,strlen($v));
$str = base64_decode($v);
 
$pos = 0;

for($j = 1 ; $j <= $data["meta"]["DevCount"]; $j++)
{
unset($hilf);
$readlen =              1; $hilf["ReadLength"] = htmlentities(ord(substr($str,$pos,1))).""; $pos += $readlen;
$readlen =              3; for($i = $pos; $i < $readlen+$pos ; $i++) $hilf["RFAdress"] .= str_pad(dechex(ord(substr($str,$i,1))),2,"0",STR_PAD_LEFT).""; $pos += $readlen;
$readlen =              1; $hilf["?1"] = dechex(ord(substr($str,$pos,1))).""; $pos += $readlen;
$readlen =              1; $hilf["Data1"] .= str_pad(decbin(ord(substr($str,$pos,1))),8,"0",STR_PAD_LEFT).""; $pos += $readlen;
$readlen =              1; $hilf["Data2"] .= str_pad(decbin(ord(substr($str,$pos,1))),8,"0",STR_PAD_LEFT).""; $pos += $readlen;

if($hilf["ReadLength"] == 11)
{
$readlen =              1; $hilf["?2"] = dechex(ord(substr($str,$pos,1))).""; $pos += $readlen;
$readlen =              1; $hilf["Temperature"] = (ord(substr($str,$pos,1))/2).""; $pos += $readlen;
$readlen =              2; for($i = $pos; $i < $readlen+$pos ; $i++) $hilf["DateUntil"] .= str_pad(decbin(ord(substr($str,$i,1))),8,"0",STR_PAD_LEFT).""; $pos += $readlen;
$readlen =              1; $hilf["TimeUntil"] = (ord(substr($str,$pos,1))*0.5).""; $pos += $readlen;
}


if($hilf["ReadLength"] == 11)
{

$deviceconf[$hilf["RFAdress"]]["Temperature"] = $hilf["Temperature"];
}



$deviceconf[$hilf["RFAdress"]]["LowBatt"] = substr($hilf["Data2"],0,1);

switch (substr($hilf["Data2"],6,2))
{
case "00" : $deviceconf[$hilf["RFAdress"]]["Mode"] = "auto"; break;
case "01" : $deviceconf[$hilf["RFAdress"]]["Mode"] = "manu"; break;
case "10" : $deviceconf[$hilf["RFAdress"]]["Mode"] = "vacation"; break;
case "11" : $deviceconf[$hilf["RFAdress"]]["Mode"] = "boost"; break;
}

 
 
 

}
//echo $v;
}
 
}
 

$ob = ob_get_contents(); 
ob_end_clean();
switch ($argv[1])
{
case "windowsstatus" : if ($deviceconf['005bfb']['Mode']=="auto" && $deviceconf['004bb8']['Mode'] =="auto" )
                        echo "2\n";
                        else echo "1\n"; 
                        break;
case "tempkueche" : echo $deviceconf['008f02']["Temperature"]; break;
case "tempwohn" : echo $deviceconf['010863']["Temperature"]; break;
case "batwohn" : echo $deviceconf['010863']["LowBatt"]; break;
case "batkueche" : echo $deviceconf['008f02']["LowBatt"]; break;
case "modekueche" : echo $deviceconf['008f02']["Mode"]; break;
case "modewohn" : echo $deviceconf['010863']["Mode"]; break;
}




?>

+14 replies

rosti

2011-11-23 20:29

User since
2011-03-19
3492 Artikel
BenutzerIn

Nurmalso nebenbei gefragt: Was macht denn ein split "\r" in einem Bytestream? Und die anderen stringFunktionen???? substr() im Bytestream???

Da läuft irgendwas verkehrt ;)

+13 replies

kami

2011-11-23 21:10

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi,

ja das weiß ich auch nicht habe lange herum experimentiert und erst mit r hat es geklappt.

Gruß kami

+12 replies

topeg

2011-11-24 13:17

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Um mit ein paar Missverständnissen auf zu räumen.
Was du da hast ist kein Stream. Bei einem Stream bleibt die Verbindung bestehen. Bei dir wird ein disconnect ausgeführt.
Die Daten sind nicht verschlüsselt. Eine Verschüsselung dient dazu das sinnvolle Interpretieren von Daten zu verhindern. Deine Daten sind nur kodiert. Der Inhalt nur ist Platzsparend verpackt und es gibt feste Regeln um die Daten lesbar zu extrahieren.

Die Konstruktion:

Code (perl): (dl )

foreach  my $v (split("\r",$buffer))
{
  print STATION $v."\n";
}

Ist unnötig komplex. Du kannst auch das schreiben:

Code (perl): (dl )

1
2

$buffer=~s/\r/\n/gs;
print STATION $buffer;

wobei ich vermute dass du auch einfach

Code (perl): (dl )

print STATION $buffer;

schreiben kannst.

Zu deinem Problem.
Schaue dir genau an was die einzelnen Funktionen in PHP machen und bilde sie in perl exakt nach. Perl und PHP sind sind sich so ähnlich, dass du dann das Hauptprogramm fast 1zu1 übernehmen kannst.

+11 replies

kami

2011-12-01 18:27

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi topeg,

vielen Dank nochmal für die super Hilfe bis her. Ich habe mich nochmal ein bißchen informiert und nun eine tolle Möglichkeit gefunden, immer die aktuellen Daten zu bekommen. Dafür muss ich nun nur noch die Zeile, die mit L: beginnt zerlegen. ICh habe dazu den PHP code vereinfacht. Leider klappt es noch nicht mit deinen Funktionen. VIelleicht hast du ja einen Tipp, wie man diesen Code entsprechend in Perl über setzen kann.

Vielen Dank.

Gruß kami

Code: (dl )

if (substr($v,0,2) == "L:")
{

$data["meta"]["DevCount"]=5;

$v = substr($v,2,strlen($v));
$str = base64_decode($v);
 
$pos = 0;

for($j = 1 ; $j <= $data["meta"]["DevCount"]; $j++)
{
unset($hilf);

$hilf["ReadLength"] = htmlentities(ord(substr($str,$pos,1))); 
$pos += 1;
 
for($i = $pos; $i < (3+$pos) ; $i++) 

$hilf["RFAdress"] .= str_pad(dechex(ord(substr($str,$i,1))),2,"0",STR_PAD_LEFT); 
$pos += 5;

$hilf["Data2"] .= str_pad(decbin(ord(substr($str,$pos,1))),8,"0",STR_PAD_LEFT).""; 
$deviceconf[$hilf["RFAdress"]]["LowBatt"] = substr($hilf["Data2"],0,1);

$pos += 1;

if($hilf["ReadLength"] == 11)
{
$pos += 1;
$deviceconf[$hilf["RFAdress"]]["Temperature"] = (ord(substr($str,$pos,1))/2).""; 
$pos += 4;
}

switch (substr($hilf["Data2"],6,2))
{
case "00" : $deviceconf[$hilf["RFAdress"]]["Mode"] = "auto"; break;
case "01" : $deviceconf[$hilf["RFAdress"]]["Mode"] = "manu"; break;
case "10" : $deviceconf[$hilf["RFAdress"]]["Mode"] = "vacation"; break;
case "11" : $deviceconf[$hilf["RFAdress"]]["Mode"] = "boost"; break;
}

}

}

topeg

2011-12-01 19:12

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Ich finde den Code grausam.
Aber hier 1:1 in Perl:

Code (perl): (dl )

use HTML::Entities;
use MIME::Base64;

...

my %data;
my %deviceconf;

...

if (substr($v,0,2) eq "L:")
{
  $data{"meta"}{"DevCount"}=5;

  substr($v,0,2,'');
  my $str = decode_base64($v);

  my $pos = 0;

  for my $j (1..$data{"meta"}{"DevCount"})
  {
    my %hilf;

    # versteh ich nicht. Hier sind nur Zahlen enthalten
    # keine Ahnung warum hier htmlentities drüber läuft
    $hilf{"ReadLength"} = htmlentities(ord(substr($str,$pos,1))); 
    $pos += 1;

    for my $i ($pos..(2+$pos))
    {
      $hilf{"RFAdress"} .= dechex2( substr( $str,$i,1 ) );
      $pos += 5;

      $hilf{"Data2"} .= decbin8( substr( $str,$pos,1 ) ).""; 
      $deviceconf{$hilf{"RFAdress"}}{"LowBatt"} = substr($hilf{"Data2"},0,1);
      $pos += 1;

      if($hilf{"ReadLength"} == 11)
      {
        $pos += 1;
        $deviceconf{$hilf{"RFAdress"}}{"Temperature"} = (ord(substr($str,$pos,1))/2).""; 
        $pos += 4;
      }

      my $val=substr($hilf{"Data2"},6,2)
      if($val eq "00")
      {
        $deviceconf{$hilf{"RFAdress"}}{"Mode"} = "auto";
      }
      elsif($val eq "01")
      {
        $deviceconf{$hilf{"RFAdress"}}{"Mode"} = "manu";
      }
      elsif($val eq "10")
      {
        $deviceconf{$hilf{"RFAdress"}}{"Mode"} = "vacation";
      }
      elsif($val eq "11")
      {
        $deviceconf{$hilf{"RFAdress"}}{"Mode"} = "boost";
      }
    }
  }
}

...

sub htmlentities
{
  my $str=shift;
  return encode_entities($str);
}

# kombination aus str_pad, decbin und ord
sub decbin8
{
  my $str=shift;
  return unpack('B8',$str);
}

# kombination aus str_pad, dechex und ord
sub dechex2
{
  my $str=shift;
  return unpack('H2',$str);
}

+9 replies

topeg

2011-12-01 23:03

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Mich lässt so was nicht in ruhe.
also hier mal ein Decoder.
Ich habe auch mal den Rest der "M:" Zeile entpackt.
more (31.5kb)

Die "C:" Elemente sollten sich auch entpacken lassen. Habe ich aber jetzt keine Lust zu und ohne weitere Informationen könnte es langwierig werden. Ich sehe das die Elemente nach dem "," Base64 kodiert sind, aber genaues könnte ich jetzt nicht sagen.

+8 replies

kami

2011-12-03 13:36

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi,

ich muss schon sagen. Echt vielen vielen Dank. Das eine super Arbeit.

Sorry das ich mich erst jetzt melde aber ich war die letzten Tage beruflich viel unterwegs. Werde mir jetzt mal ordentlich Zeit nehmen das sauber bei mir einzuarbeiten.

Ich danke vielmals :)

Gruß kami

+7 replies

kami

2011-12-20 21:28

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi,

so nach langer Zeit, sorry ich hatte viel auf der Arbeit zu tun. Bin ich nun mal wieder dazu gekommen, etwas an dem Script rumzuschrauben. Die Auswertung des L: Textes ist jetzt Fehlerfrei und sieht genauso aus, wie ich es brauche. Dazu sieht der Code jetzt so aus:

Code (perl): (dl )

#!/usr/bin/perl -w
use strict;
use warnings;

use utf8;
use IO::Socket;
use MIME::Base64;

use Data::Dumper;
$Data::Dumper::Useqq=1;


my $host = "192.168.1.36"; # Your Cube-IP or hostame Here!
my $port = "80";
my $devices = "5";
  my $handle = IO::Socket::INET->new(
          Proto     => "tcp",
          PeerAddr  => $host,
          PeerPort  => $port
        ) // die("ERROR open Socket $host:$port ($!)\n");

  $handle->blocking(0);
  binmode($handle);
  
  
while(1)
{

  

  my $finished = 0;
  my $time=time();
  my $buffer='';
  
  while(time() < $time+20 && $finished==0)
  {
    my $line='';
    $handle->read($line,4096);
    $finished=1 if(index($buffer,'L:')!=-1);
    $buffer.=$line if(length($line));
    
  }



  if(!$finished)
  {
    print "No Connection\n";
    next;
  }
   my %data;
  my %deviceconf;


   
for my $v (split(/[\x0D\x0A]+/,$buffer))
{
  if($v=~/^L:(.+)/g)
  {
    my %hilf;
    my $str=decode_base64($1);
  
    for(1..$devices)
    {
      my $length=substr_ord(\$str,1);
      next if($length<6);

      my ($rfaddr,$x1,$data1,$data2)=unpack('H6 H2 B8 B8',substr($str,0,6,''));
      
      if($rfaddr eq '005fd6')
      { $rfaddr = 'KuecheFe' }
      elsif($rfaddr eq '008f02')
      { $rfaddr = 'KuecheTh' }
      elsif($rfaddr eq '010863')
      { $rfaddr = 'WohnTh' }
      elsif($rfaddr eq '004bb8')
      { $rfaddr = 'WohnFe' }
      elsif($rfaddr eq '005bfb')
      { $rfaddr = 'Eco' }
      else {$rfaddr = $rfaddr}  
      
      $deviceconf{$rfaddr}={
          
          LowBat => substr($data2,0,1,'')
          
        };
        

      if($length == 11)
      {
        my ($x2,$temp,$date,$time)=unpack('C C B16 C',substr($str,0,5,''));

          $deviceconf{$rfaddr}{Temperatur}=$temp/2;

      }

      my $sub=substr($data2,6,2);
      
      if($sub == 0)
      { $deviceconf{$rfaddr}{Mode} = 'auto' }
      elsif($sub == 1)
      { $deviceconf{$rfaddr}{Mode} = 'manu' }
      elsif($sub == 2)
      { $deviceconf{$rfaddr}{Mode} = 'vacation' }
      elsif($sub == 3)
      { $deviceconf{$rfaddr}{Mode} = 'boost' }
    }
  }
} 



 print Dumper(\%deviceconf);  

   
   sleep(1);

                  
   $handle->send("l:");

   
}

$handle->close(); 

sub substr_del { return substr( ${$_[0]}, 0, $_[1], '') }
sub substr_ord { return unpack('C*', substr_del(@_) ); }
sub substr_hex { return unpack('H*', substr_del(@_)); }

sub substr_hex_fix {
  my $str=shift;
  my $length=shift;
  return unpack("H".($length*2), substr_del($str,$length));
}

sub substr_bin { return unpack('B8', substr_del(@_)); }

Was mir nun fehlt ist folgendes:

Wenn ich die eine Telnet verbindung zum System aufmache, dann kriege ich ja als erstes den kompletten Output, der ausgewertet werden kann. Danach passiert ja nix mehr. Falls ich nun aber ein "l:" sende, dann bekomme ich wieder den L:-Teil zurück gegeben. Das möchte ich nun kontinuierlich in der Schleife tun. Leider bekomme ich keine Ausgabe wenn ich wie oben beschriebn das "l:" sende. Was amche ich falsch? in der Telnet verbindung muss ich nur l: eingeben und mit ENTER bestätigen. Vielen dank für Tipps.

Cu kami

+3 replies
Gast wer

2011-12-20 22:10

Wenn du im Terminal Return drückst dann sende doch "l:\n"
Last edited: 2011-12-20 22:11:22 +0100 (CET)
- +2 replies
- kami
  
  2011-12-21 08:37
  
  User since
  2010-03-17
  92 Artikel
  BenutzerIn
  
  Okay danke, aber muss ich das irgendwie anders schicken, weil ich auf Binmode umgestellt habe.
  
  Gruß kami
  - kami
    
    2011-12-21 15:17
    
    User since
    2010-03-17
    92 Artikel
    BenutzerIn
    
    Hi,
    
    also trotz intensiver Tests und enormen verschlanken des Codes. Bekomme ich keine Werte zurück und nach den eingestellten 20sec kriege ich immer "No Connection" woran kann das liegen?
    
    Gruß kami
+3 replies

rosti

2011-12-21 20:35

User since
2011-03-19
3492 Artikel
BenutzerIn

Dein Server spricht HTTP oder ein ähnliches Protokoll: Du schreibst Bytes in ein Socket und der Server antwortet (Client:Request, Server:Response). Evntl. wäre Net::HTTP - Low-level HTTP connection (client) was für Dich oder auch LWP::UserAgent. Wenn Du genau weißt, wie das Protokoll abläuft in Deinem konkreten Fall (was für mich immer noch nicht klar ist), kannst Du das in Perl nachbilden, entweder mit o.g. Modulen oder auch mit IO::Socket.

+2 replies

kami

2011-12-23 11:17

User since
2010-03-17
92 Artikel
BenutzerIn
[default_avatar]

Hi,

also ich kann da machne was ich will. Unter Telnet brauche ich nur l:(Enter) schicken und alles klappt unter Perl kommt nix rein. Habe mir folgendes Skript zum Testen geschrieben. Aber kein Erfolg. Vielleicht hat jemand ja einen Tipp:

Code (perl): (dl )

#!/usr/bin/perl -w
use strict;
use warnings;

use utf8;
use IO::Socket;
use MIME::Base64;

use Data::Dumper;
$Data::Dumper::Useqq=1;


my $host = "192.168.1.36"; # Your Cube-IP or hostame Here!
my $port = "80";
my $devices = "5";
  my $handle = IO::Socket::INET->new(
          Proto     => "tcp",
          PeerAddr  => $host,
          PeerPort  => $port
        ) // die("ERROR open Socket $host:$port ($!)\n");

  $handle->blocking(0);
  binmode($handle);
  
  
while(1)
{

  

  my $finished = 0;
  my $time=time();
  my $buffer='';
   print "Send2\n";  
  while(time() < $time+20 && $finished==0)
  {
    my $line='';
    $handle->read($line,4096);
    $finished=1 if(index($buffer,'L:')!=-1);
    $buffer.=$line if(length($line));
    
  }



  if(!$finished)
  {
    print "No Connection\n";
    next;
  }

    print $buffer;
    
   

   
   sleep(1);
    
    print "Send\n";              
   $handle->send("l:\n");

   
}

$handle->close();

Vielen Dank.

Gruß kami

rosti

2011-12-23 17:35

User since
2011-03-19
3492 Artikel
BenutzerIn

Quote
also ich kann da machne was ich will. Unter Telnet brauche ich nur l:(Enter) schicken und alles klappt unter Perl kommt nix rein. Habe mir folgendes Skript zum Testen geschrieben. Aber kein Erfolg. Vielleicht hat jemand ja einen Tipp:

Net::Telnet

http://search.cpan.org/~jrogers/Net-Telnet-3.03/li...

View all threads created 2011-11-09 13:05.