Thread Active Perl Probleme (3 answers)
Opened by Stefan at 2009-03-05 21:13

Gast Stefan
 2009-03-06 15:29
#273 #273
Hallo,

ich habe mal versucht, dass ganze möglichst kurz zum laufen zu bringen mit den beiden Problemen. Es bleiben trotzdem noch die folgenden Zeilen Code:

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
use CGI qw/:standard/;
use Config;
use English;
use HTTP::Daemon;
use HTTP::Status;
use IO::Socket qw(:DEFAULT :crlf);
use strict;
use threads;
use threads::shared;

my $from_server;
my $name = $0; 
my $peer = '192.168.1.1'; 
my $UserModus           : shared = 0;
my $Betriebsmodus       : shared = $UserModus; 
my $BetriebStart        : shared = 0; 
my $My_IP               : shared = '0.0.0.0'; 

if ($Config{usethreads}) { print "This version of Perl has thread support\n" }
my $thr1 = threads->new(\&a1);
my $thr2 = threads->new(\&a2);
$thr1->join; 
$thr2->join; 
print "Ende von threads2 \n\n";

sub a1{
my $http_Name = "HTTP Server";
my $String; 
my ($str0, $str1, $str2, $str3, $str4, $str5, $str6, $str7, $str8, $str9); 

my $d = HTTP::Daemon->new(
        LocalHost => $My_IP,
        LocalPort => 3002,);
die "http_Name: Socket konnte nicht erstellt werden - Grund: $!\n" unless $d;

while (my $c = $d->accept) { 
        while (my $r = $c->get_request) { 
                if ($r->method eq 'GET') {
                        $Betriebsmodus = 1;
                        my $rs = new HTTP::Response(RC_OK);
                        $rs->content(CGI::start_html(-title=>' Anzeige '));
                        $rs->add_content(CGI::start_form);
                        $rs->add_content("Anzeige". CGI::br);
                        $rs->add_content(CGI::submit(-name=>'Sparbetrieb', -value=>'Sparbetrieb') . CGI::p . CGI::submit(-name=>'Normalbetrieb', -value=>'Normalbetrieb'));
                        $rs->add_content(CGI::end_form . CGI::hr . CGI::end_html);
                        $c->send_response($rs);
                        $c->get_request;
                }
                elsif ($r->method eq 'POST') {
                        $String = $r->content;
                        my $rs = new HTTP::Response(RC_OK);
                        ($str0, $str1, $str2, $str3, $str4, $str5, $str6, $str7, $str8, $str9 )=$String=~/(.+)\s+(.+)\s+(.+)\s+(.+)\s+(.+)\s+(.+)\s+(.+)\s+(.+)\s+(\w+)\s+(.+)\s+(.*)/;
                        chomp($str8);
                        if ($str8 eq 'Sparbetrieb'){ 
                                $UserModus = 0;
                        }
                }
                else {
                        $c->send_error(RC_FORBIDDEN)
                }}
        $c->close;
        undef($c);
        $Betriebsmodus = $UserModus;
}}

sub a2{
$OUTPUT_AUTOFLUSH = 1;
my $socket = IO::Socket::INET->new(PeerAddr => $peer,
                                   PeerPort => '3003',
                                   Proto    => 'tcp',)
or die " $name:   Fehler: Kann keine Verbindung zu $peer aufbauen. Grund:\n $! \n";
SPAR:   print $socket "Power(0)\r\n" or die "Power nicht möglich\n";
        while(!$Betriebsmodus and !$BetriebStart){sleep 1;}     
        print $socket "Power(1)\r\n" or die "Power nicht möglich\n";
        while ($Betriebsmodus or(!$Betriebsmodus and $BetriebStart)){
        if(defined (my $from_server = <$socket>)) { 
                print "Hallo Welt\n";
        }
        }
        if(!$Betriebsmodus and !$BetriebStart){goto SPAR;}
die  "\n Programmende \n\n";
}


Das sollte aber grundsätzlich funktionieren. Die beiden beschriebenen Probleme bleiben aber erhalten.

Stefan
Last edited: 2009-03-06 15:35:35 +0100 (CET)

View full thread Active Perl Probleme