Schrift
Wiki:Tipp zum Debugging: use Data::Dumper; local $Data::Dumper::Useqq = 1; print Dumper \@var;
Start · Board · Webprogrammierung mit Perl · Webframeworks, Sonstige Fragen zur Webprogrammierung mit Perl
[thread]12563[/thread]

Probleme mit Tausenderpunkt



<< >> 6 Einträge, 1 Seite
sven2006
 2008-09-30 17:11
#115030 #115030
User since
2008-09-30
7 Artikel
BenutzerIn
[default_avatar]
Hallo ich bin absoluter Noob in Perl und versuche jetzt hier Hilfe zu bekommen.

Also ich spiele Ogame(Browserspiel) und habe ein älteres Allianzverwaltungstool übernommen, das mit keinem konkurrieren kann und es wäre zu schade wenn man das nicht aktualisiert bekommt
Nun versuch ich verzweifelt das das Tool auch die Tausenderpunkte erkennt. Bedeutet, ich kopiere aus einer vorhanden Seite die Werte und es wird dann ins Tool gepastet und in eine DB verwertet und im Tool augegeben.

in dem ersten Fall sieht es so aus:
Mitgliederliste (Anzahl: 8)
Nr. Name Status Punkte Koord Beitritt Online
1 MetaIIica Unischreck 2.460.037 [3:436:5] 2008-09-04 22:16:13 On

Problem ist jetzt da die [ ] und die Tausenderpunkte

Davor war es so:
Mitgliederliste (Anzahl: 8)
Nr. Name Status Punkte Koord Beitritt Online
1 MetaIIica Unischreck 2460037 3:436:5 2008-09-04 22:16:13 On

Das ist das was es im Moment erkennt.

der Code dazu:

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

if ($pasted ne "0") {
        my ($player, $points, $koo) = ("", -1, "");
        my $id;
        foreach (split(/\n/, $pasted)) {
                ($player, $points, $koo) = ("", 0, "");
                my $regex = Ogame::translate(/Nachricht_schreiben/);
                if (/$regex/) {
                        # firefox:
                        #9      Giggel  Nachricht schreiben     Ratsmitglied    251235  2:280:11        -       On
                        my @foo = split(/\t/);
                        ($player, $points, $koo) = ($foo[1], $foo[4], $foo[5]);
#                       print 'found1 ($player, $points, $koo) ='." ($foo[1], $foo[4], $foo[5])<br>";
                } elsif (/^\d+\t(.*)\t\t.*?\t\s*(\d+)\t\s*([0-9:]+)\s*\t/) {
                        # opera
                        #10     Julia           Drohne  35098   7:88:4  2006-03-31 12:31:39     On      
                        ($player, $points, $koo) = ($1, $2, $3);
#                       print 'found2 ($player, $points, $koo) ='." ($1, $2, $3)<br>";
                } elsif (/^\d+\s+(.*)\s+[\wü]+\s+(\d+)\s+(.*?)\s+/) {
                        ($player, $points, $koo) = ($1, $2, $3);
#                       print 'found3 ($player, $points, $koo) ='." ($1, $2, $3)<br>";
                }
                if (($player ne "") && ($points > -1) && ($koo ne "")) {
                        $sth = $dbh->prepare("select id from $uni{'name'}_allymember where player=?;");
                        $sth->execute($player);
                        if ($sth->rows == 0) {
                                $sth = $dbh->prepare("insert into $uni{'name'}_allymember set player=?, koo=?;");
                                $sth->execute($player, $koo);
                                $sth = $dbh->prepare("select id from $uni{'name'}_allymember where player=?;");
                                $sth->execute($player);
                                print "new player: $player ($koo)<br>";
#                               print "<br>insert into $uni{'name'}_allymember set player='$player', koo='$koo'<br>";
                        }
                        $id = $sth->fetchrow_array;
                        $sth = $dbh->prepare("update $uni{'name'}_allymember set timestamp=NOW() where id=?;");
                        $sth->execute($id);
                        $sth = $dbh->prepare("select age from $uni{'name'}_allymember_points where player_id=? and age=?;");
                        $sth->execute($id, $age);
                        if ($sth->rows == 0) {
                                $sth = $dbh->prepare("insert into $uni{'name'}_allymember_points set player_id=?, points=?, age=?;");
                                $sth->execute($id, $points, $age);
                        } else {
                                $sth = $dbh->prepare("update $uni{'name'}_allymember_points set points=? where player_id=? and age=?;");
                                $sth->execute($points, $id, $age);
                        }
                } else {
#                       print "Parse error: $_<br>";
                }
        }
}



Beim zweiten habe ich das gleiche Prob:
Neu:
Platz Spieler Allianz Punkte
401 * Hellrazor Nachricht schreiben KoC 2.585.555

Alt:
Platz Spieler Allianz Punkte
401 * Hellrazor Nachricht schreiben KoC 2585555

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

if (defined($cgi->param('parse'))) {
        @lines = split(/\n/, $cgi->param('pasted'));
        my $line;
        $text .= "<table border>\n";
        $text .=  "<tr><td colspan=4>Update <small>(wenn leer, ging was schief!)</small></td></tr>\n";
        $text .=  "<tr><td>Platz</td><td>Spieler</td><td>Ally</td><td>Punkte</td></tr>\n";
        my $i = 0;
        my $cnt = 0;
        foreach $line (reverse @lines) {
                #3   +  PG Power                kaffee  178392  
                #4   –         sand            kaffee  176800  
                #5   *  Done it Duncan          XCT     159366  
                next unless ($line =~ /[^\s]/);
                my @valuez = split(/\t/, $line);
                next unless(defined($valuez[4]));
                foreach (@valuez) {
                        s/^\s*//;
                        s/\s*$//;
                }
                $valuez[0] =~ /^(\d+)/;
                $valuez[0] = $1;
                $valuez[4] =~ s/[^\d]//g;
                next unless (defined(($valuez[0])));
                next if ($valuez[4] eq "");
                next if ($valuez[4] =~ /[^\d]/);
                if ($i == 0) {
                        $sth = $dbh->prepare("select platz from $uni{'name'}_ogame_players order by platz desc limit 1;");
                        $sth->execute();
                        my $last = $sth->fetchrow_array;
                        for ($i = $last + 1; $i <= $valuez[0]; $i++) {
                                $sth = $dbh->do("insert into $uni{'name'}_ogame_players set platz='$i';");
                                $cnt++;
                        }
                        $i = 1;
                }
                if (($valuez[0] =~ /(\d+)/) && ($valuez[1] ne "")){
                        $sth = $dbh->do("update $uni{'name'}_ogame_players set ally='$valuez[3]', punkte='$valuez[4]', name='$valuez[1]', date=NOW() where platz='$1';");
                        $cnt++;
                        $text .=  "<tr><td>$1</td><td>$valuez[1]</td><td>";
                        if ($valuez[3] ne "") {
                                $text .=  $valuez[3];
                        } else {
                                $text .=  "&nbsp;";
                        }
                        $text .=  "</td><td>$valuez[4]</td></tr>\n";
                } else {
                        $text .=  "<!--tr><td colspan=4>Diese Zeile wird ignoriert: $line</td></tr-->\n";
                }
        }
        $text .=  "</table>\n$cnt Zeilen wurden verwendet";
}


dritte wäre das hier:

neu:
Platz Allianz Memb. Punkte
1 * Xel FoCC 19 127.335.357

alt
Platz Allianz Memb. Punkte
1 * Xel FoCC 19 127335357

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

if ($parse_stats == 1) {
        my $pasted = $cgi->param('pasted');
        if ($pasted eq "") {
                print '<center><b style="font-size:20pt; color:#EE0000;">dumm geklickt, was?</b></center><br>';
        } else {
#               $sth = $dbh->prepare("delete from allystats where date=curdate();");
#               $sth->execute;
                my ($place, $ally, $members, $points, $valid) = (0, "", 0, 0, 0);
                my @todo = ();
                my ($start, $end) = (99999, 0);
                foreach (split(/\n/, $pasted)) {
                        # 1   *         T.u.C           17      43842   2578
                        next unless (/^\s*\d+/);
                        my @arr = split(/\s+/, $_);
                        if ($#arr >= 5) {
                                if ($arr[0] > 0) {
                                        $place = shift @arr;
                                        $start = $place if ($place < $start);
                                        $end = $place if ($place > $end);
                                        shift @arr; pop @arr;
                                        $points = pop @arr;
                                        $members = pop @arr;
                                        $ally = join(" ", @arr);
                                        push(@todo, "insert into $uni{'name'}_allystats set ally='$ally', members='$members', points='$points', date=curdate(), place='$place';");
                                        $valid++;
                                }
                        } else {
                                #print "Fehler beim parsen der Zeile: ".join(" ", @arr)."<br>\n" if (@arr != ());
                        }
                }
                $sth = $dbh->prepare("delete from $uni{'name'}_allystats where place>=? and place<=? and date=curdate();");
                $sth->execute($start, $end);
                $sth = $dbh->do($_) foreach (@todo);
                $template->param(TMP => "Es konnten $valid Zeilen benutzt werden (Pl&auml;tze $start - $end).");
        }
}


Meine Idee wäre das die Tausenderpunkte und die [] in irgendeiner Form ignoriert werden

Kann mir da einer helfen? Ich sags von vornherein, ich hab nicht die geringste Ahnung von Perl und wäre auch mit externen Lektüre hoffnungslos überfordert. Ich wäre euch dankbar wenn ihr mir da helfen könntet

lg
Sven
renee
 2008-09-30 17:31
#115031 #115031
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Zum ersten:

Aus
Code (perl): (dl )
1
2
3
4
5
6

elsif (/^\d+\t(.*)\t\t.*?\t\s*(\d+)\t\s*([0-9:]+)\s*\t/) {
                        # opera
                        #10      Julia           Drohne  35098   7:88:4  2006-03-31 31:39     On      
                        ($player, $points, $koo) = ($1, $2, $3);
#                        print 'found2 ($player, $points, $koo) ='." ($1, $2, $3)<br>";
                }


wird
Code (perl): (dl )
1
2
3
4
5
6
7

elsif (/^\d+\t(.*)\t\t.*?\t\s*(\d+)\t\s*\[([0-9:]+)\]\s*\t/) {
                        # opera
                        #10      Julia           Drohne  35098   7:88:4  2006-03-31 31:39     On      
                        ($player, $points, $koo) = ($1, $2, $3);
                        $points =~ s/\.//g;
#                        print 'found2 ($player, $points, $koo) ='." ($1, $2, $3)<br>";
                }


Beim zweiten sollte gar nichts zu machen sein, weil da ja schon $valuez[4] =~ s/[^\d]//g; gemacht wird, das die Punkte löscht.
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
renee
 2008-09-30 17:33
#115032 #115032
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
zu drittens:

Aus
Code (perl): (dl )
$points = pop @arr;


muss
Code (perl): (dl )
1
2

$points = pop @arr;
$points =~ s/\.//g;
werden.
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
sven2006
 2008-09-30 18:24
#115035 #115035
User since
2008-09-30
7 Artikel
BenutzerIn
[default_avatar]
Vielen vielen Dank für deine prompte Hilfe :) Hat wunderbar funktioniert

Aber jetzt wirds Zeit Prl zu lernen:)
sven2006
 2008-10-01 07:27
#115048 #115048
User since
2008-09-30
7 Artikel
BenutzerIn
[default_avatar]
So, nun kommt das nächste Prob wo ich jetzt seit Stunden dransitze....

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

       foreach $line (@lines) {
           my ($ally, $planet_name, $player) = ('', '', '');
           my ($planet, $moon, $idle, $disabled) = (0, 0, 0, 0);
           ($galaxy, $system) = ($1, $2) if ($line =~ /$ssystem\s(\d+):(\d+)/);
           if ($line =~ /^(\d+)\s\t\t(.*?)\s\tMond\s\(Gr.*?(\d+)\)\s\t\t(.*?)\s\t(.*?)\s\tSpionieren/) {
#11         Imperators Palace     Mond (Grö 7416)         TLL     L.o.D    Spionieren Nachricht schreiben Buddyanfrage
               ($planet, $planet_name, $moon, $player, $ally) = ($1, $2, 1, $4, $5);
               print "$planet: match0 firefox - Mond: $3<br>" if ($debug);
           } elsif ($line =~ /^(\d+)\s\t\t(.*?)\s\t\t\t(.*?)\s\t(.*?)\s\tSpionieren/) {
#5         EARTH OF DEATH 7             deathking     B.H.H.     Spionieren Nachricht schreiben Buddyanfrage
               ($planet, $planet_name, $moon, $player, $ally) = ($1, $2, 0, $3, $4);
               print "$planet: match1 firefox/opera, no moon - $planet_name<br>" if ($debug);
           } elsif ($line =~ /^(\d+)\s\t\t(.*?)\s\tMond\s\(Gr.*?(\d+)\)\s\t\t(.*?)\s\t(.*?)\s/) {
#5         Masters of Puppets     Mond (Grö 7416)         MetaIIica     XCT
               ($planet, $planet_name, $moon, $player, $ally) = ($1, $2, 1, $4, $5);
               print "$planet: match0 firefox - Mond: $3<br>" if ($debug);
           } elsif ($line =~ /^(\d+)\s\t\t(.*?)\s\t\t\t(.*?)\s\t(.*?)\s/) {
#5         Justice for All             MetaIIica     XCT                   ($planet, $planet_name, $moon, $player, $ally) = ($1, $2, 0, $3, $4);
               print "$planet: match1 firefox/opera, no moon - $planet_name<br>" if ($debug);
           } elsif ($line =~ /^(\d+)\s\t\t(.*?)\s\t\t\t(.*?)\s\t\tSpionieren/) {
#5         kol 174             Little Destroyer (i g I u)         Spionieren Nachricht schreiben Buddyanfrage
               ($planet, $planet_name, $moon, $player, $ally) = ($1, $2, 0, $3, "");
               print "$planet: match2 firefox, no moon, no ally - $planet_name<br>" if ($debug);
           } elsif ($line =~ /^(\d+)\s+($destroyed)\s+/) {
               $planet = $1;
               print "$planet: Zerstörter Planet<br>" if ($debug);
           } elsif ($line =~ /^(\d+)\s+$/) {
               $planet = $1;
               print "$planet: nicht kolonisiert<br>" if ($debug);
           } elsif ($line =~ /(\d+)\t(Unendliche Weiten)/) {
#16    Unendliche Weiten
               print "$1: $2<br>" if ($debug);
           }
           $planet_name =~ s/\s\(.*//;
           if ($player =~ /\(([a-z]+)\)$/i) {
               my $state = $1;
               $idle = 1 if ($state =~ /i/);
               $idle = 2 if ($state =~ /iI/);
               $disabled = 1 if ($state =~ /g/);
               $player =~ s/\(([a-z]+)\)$//i;
           }
           $player =~ s/\s*\(.*//;
           if ($planet != 0) {
               next if (($galaxy eq "") || ($system eq ""));
               $planetsok++;
               push(@query, "insert into $uni{'name'}_psm values (?, ?, ?, ?, ?, ?, NOW(), ?, ?, ?);");
               push(@vals, $galaxy, $system, $planet, $planet_name, $ally, $player, $idle, $disabled, $moon);
           }
       }


Die im # funktionieren nur jetzt kommt nochwas dazu was mir Kopfschmerzen bereitet..... Sobald vor Spionieren der Begriff Spiobericht ansehen hinzukommt, wird nix mehr geparst

4 Krypton (*) GroundZero UCE Spiobericht ansehen Spionieren Nachricht schreiben Buddyanfrage


6 Geiler Macker Mond (Größe: 7000) non K1 Spiobericht ansehen Spionieren Nachricht schreiben Buddyanfrage


Das sind die Zeilen die dafür sorgen das nix geht. Jede der genannten Möglichkeiten treten auf

Meine Gedankengänge waren dann folgende wo dann folgendes hinzugefügt wird:

Code (perl): (dl )
1
2
3
4
5
6
7
8
9

elsif ($line =~ /^(\d+)\s\t\t(.*?)\s\tMond\s\(Gr.*?(\d+)\)\s\t\t(.*?)\s\t(.*?)\s\tSpiobericht ansehen\s\tSpionieren/) {
#4              Geiler Macker     Mond (Größe: 7000)                    non    K1     Spiobericht ansehen Spionieren Nachricht schreiben Buddyanfrage
               ($planet, $planet_name, $moon, $player, $ally) = ($1, $2, 1, $4, $5);
               print "$planet: match0 firefox - Mond: $3<br>" if ($debug);
           } elsif ($line =~ /^(\d+)\s\t\t(.*?)\s\t\t\t(.*?)\s\t(.*?)\s\tSpiobericht ansehen\s\tSpionieren/) {
#                  4            Krypton (*)                       GroundZero     UCE    Spiobericht ansehen Spionieren Nachricht schreiben Buddyanfrage
               ($planet, $planet_name, $moon, $player, $ally) = ($1, $2, 0, $3, $4);
               print "$planet: match1 firefox/opera, no moon - $planet_name<br>" if ($debug);
           }




was ist daran falsch?? Denn so funktioniert es nicht :(
sven2006
 2008-10-01 08:51
#115049 #115049
User since
2008-09-30
7 Artikel
BenutzerIn
[default_avatar]
Problem doch noch hinbekommen^^

Ich hab jetzt einfach Zeile 5 bis 17 nochmal reinkopiert und tSpionieren mit tSpiobericht ansehen ersetzt. Und siehe da es lüpt

Hat sich somit erstmal erledigt :)
<< >> 6 Einträge, 1 Seite



View all threads created 2008-09-30 17:11.