Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Allgemeines zu Perl
[thread]12015[/thread]

Zeile in Datei finden und löschen - Funktioniert nicht

Leser: 1


<< >> 10 Einträge, 1 Seite
seraphim
 2008-06-15 17:48
#111042 #111042
User since
2008-06-15
5 Artikel
BenutzerIn
[default_avatar]
Ich bin meines Zeichens Perl Anfänger und schreibe gerade an einem IRC Bot.

Nun will ich auf Befehl hin den Bot eine Zeile aus einer Datei löschen lassen.
Dies hab ich so gelöst:

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

                        if (($line[3] eq ":remove") && (defined $line[4])) {
                                open my $handle1, '<', $srcpath or die "Cant open File: $!";
                                my @list;
                                my $search = "$line[4]";
                                print Dumper($search);
                                while (my $x = <$handle1>) {
                                        chomp $x;
                                        if ($x ne $search) {
                                                push @list, $x;
                                                print "$x";
                                        };
                                };
                                close ($handle1);
                                open my $handle2, '>', $srcpath or die "Cant open File: $!";
                                foreach my $o (@list) {
                                        print $handle2 "$o\n";
                                };
                                close($handle2);
                        };


Nun funktioniert es leider nicht, die Stelle wird nicht aus der Datei entfernt und am Ende der Datei wird immer eine Zeile mit einem Leerzeichen geschrieben.
Ich weiß der Code bzw die Idee ist nicht die optimale Lösung doch ich bin erstmal dabei das zu lernen und dann zu optimieren.
moritz
 2008-06-15 18:20
#111043 #111043
User since
2007-05-11
923 Artikel
HausmeisterIn
[Homepage]
user image
Was sagt denn die Zeile 'print Dumper($search);'?

Und bist du dir sicher, dass du keine Datenbank verwenden willst? ;-)
Perl 6 - Perls Zukunft
seraphim
 2008-06-15 18:31
#111044 #111044
User since
2008-06-15
5 Artikel
BenutzerIn
[default_avatar]
Ausgabe:
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

:seraphim!seraph@Testserver-3A93D94C PRIVMSG Prsc :remove 127.0.0.1
$VAR1 = '127.0.0.1';
200.46.107.2
200.49.91.13
202.103.23.169
202.104.255.21
202.131.0.16
202.155.95.86
202.160.12.27
202.237.7.131
127.0.0.1
202.28.52.3
202.32.27.29
202.53.236.17
202.76.4.28
202.96.80.28
202.97.143.101
202.99.195.50


AAAA 200.46.107.2
200.49.91.13
202.103.23.169
202.104.255.21
202.131.0.16
202.155.95.86
202.160.12.27
202.237.7.131
127.0.0.1
202.28.52.3
202.32.27.29
202.53.236.17
202.76.4.28
202.96.80.28
202.97.143.101
202.99.195.50


Inhalt der Datei:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
200.46.107.2
200.49.91.13
202.103.23.169
202.104.255.21
202.131.0.16
202.155.95.86
202.160.12.27
202.237.7.131
127.0.0.1
202.28.52.3
202.32.27.29
202.53.236.17
202.76.4.28
202.96.80.28
202.97.143.101
202.99.195.50


Die Leerzeichen sind mit dabei

Mit Datenbank meinst du alá SQL? Würd sagen erst einmal etwas perl beherrschen, kleinere Sachen bauen und dann erweitern/optimieren ^^
Man brauch ja nicht gleich mit dicken Büchern auf Newbies schießen ^^
betterworld
 2008-06-15 21:04
#111045 #111045
User since
2003-08-21
2614 Artikel
ModeratorIn

user image
Aber was steht in $line[4]?

Wahrscheinlich ist da irgendwo ein Whitespace-Problem oder so.

Bitte ganz genau durchlesen: Code im Beitrag
Lieblingsmodule: CPAN:IPC::System::Simple, CPAN:Path::Class
seraphim
 2008-06-15 21:59
#111046 #111046
User since
2008-06-15
5 Artikel
BenutzerIn
[default_avatar]
Das gibt ja der Dumper schon aus als:
02: $VAR1 = '127.0.0.1';
betterworld
 2008-06-15 22:17
#111047 #111047
User since
2003-08-21
2614 Artikel
ModeratorIn

user image
seraphim+2008-06-15 19:59:32--
Das gibt ja der Dumper schon aus als:
02: $VAR1 = '127.0.0.1';

Ah, uebersehen.

Und, mal den Link angeguckt? Dann kannst Du ja nun mal versuchen, einen Code zu posten, den wir auch ausfuehren koennen, sodass wir das Problem demonstriert bekommen. Aber bitte nicht den ganzen IRC-Bot.
Denn so sehe ich da auch keinen Fehler. Vermutlich liegt er nicht in dem Code, den Du gepostet hast.
Lieblingsmodule: CPAN:IPC::System::Simple, CPAN:Path::Class
seraphim
 2008-06-15 22:31
#111048 #111048
User since
2008-06-15
5 Artikel
BenutzerIn
[default_avatar]
hmm das sind nur ca 170 zeilen, und da was drum rum zu bauen ist naja ^^

und Nachspielen wird für welche ohne ircD recht schwer teilweise

Deshalb mal den kompletten 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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

#!/usr/bin/perl
#IP BL Bot v1.0 by seraphim, mit freundlicher Unterstützung der Supporter
#von de.perl.org und unter mithilfe von Talustus
#Support gibts nirgends, also seht wie ihr klar kommt :D
use strict;
use IO::Socket::INET;
use English;
use warnings;
use Data::Dumper;

#Pfadangabe zur Blacklistdatei!!!
my $srcpath = 'H:\perl\result.txt';
#Login Daten
my $operacc = "seraphim"; #Oper Account
my $operpw = "seraphim"; #Oper Passwort
my $nick = "P"; #Nick des Bots
my $ident = "Ident"; #Ident des Bots
my $rname = "Realname"; #Realname des Bots
my $chan = "#main"; #Channel, in den geloggt werden soll
my $bantime = "3600"; #Banzeit der GZLine in Sekunden
my $banreason = "Your IP is blacklisted at our local Database.";

#Operatoren des Bots, nimmt Befehle nur via PM an!
#Format: qw(nick nick nick nick nick);
my @opers = qw(seraphim);

#Socket öffnen
my $sock = IO::Socket::INET->new(
    PeerAddr => '127.0.0.1', #Adresse des IRCd´s
    PeerPort => 6667, #Port
    Proto    => 'tcp',
) or die $!;
#Introduction senden
print $sock "NICK $nick\r\n";
print "<NICK $nick\n";
print $sock "USER $ident localhost.de testserv.de :$rname\r\n";
print "<USER $ident localhost.de testserv.de $rname\n";
print $sock "JOIN :$chan\r\n";
print "JOINE :$chan\n";

my $oldnick = $nick;
my $idlemode = "0";

while (<$sock>) { #so lange $sock aktiv ist (also für alles was übertragen wird)
    chomp($_);
    if ($_ =~ /^PING(.*)$/i) {
        print $sock "PONG $1\r\n"; #ping-pong
    }else {
        #print ">$_\n"; #Debug Print
    };
    my @line = split ' ', $_; #aufteilen von $_ getrennt an chr32 zu $line[x]             local $/ = "\n";
    chomp @line;
    local $/ = "\r";
    chomp @line;
    if ($line[1] eq "376") { #bei Ende von /lusers Antwort
          print $sock "OPER $operacc $operpw\r\n";
          print "<OPER $operacc $operpw\n";
          print $sock "MODE $nick +Hpis +cFG\r\n";
          print "<MODE $nick +Hpis +cFG\n";
    };
    if ($idlemode == 0) {
            if ((defined $line[6]) && (defined $line[10])) {
               if (($line[6] eq "Client") && ($line[7] eq "connecting")) {
                  if ($line[8] eq "at") {
                     print $sock "USERIP $line[10]\r\n";
                     print "<USERIP $line[10]\n";
                  };
                  if (($line[8] eq "on")&& (defined $line[11])) {
                        print $sock "USERIP $line[11]\r\n";
                        print "<USERIP $line[11]\n";
                  };
               };
            };
    };
    #antwort auf /userip, Abgleich mit Liste
    if ($line[1] =~ /^\d+$/) {
       if ($line[1] == 340) {
          #print "$_\n";
          my @i = split /\@/, $_; #auftrennen von $_ an @
          my $ip = $i[1]; #definieren von $ip an $i[1], ist die IP von $_ hinter @
          if (defined $ip) { #Prüfung ob es überhaupt $ip gibt, für den fall dass User bei Userip nicht mehr online ist
             my @ipt = split /\./, $ip; #auftrennen von $ip (zb 127.0.0.1) an . in vier Blöcke
             $ipt[3] =~ s/\s{4}\z//; #entfernen der 4 Leerzeichen hinter dem letztem IP Block
             my $ipx = "$ipt[0].$ipt[1].$ipt[2].$ipt[3]"; #Zusammensetzen der editierten Strings zu einer reinen IP
             local $/ = "\n";
             chomp $ipx;
             #Blacklistdatei öffnen
             open my $handle, '<', $srcpath or die "Cant open File: $!";
             while (my $line = <$handle>) { #Durchlauf von @ipbl, der IP Blacklist
                   chomp $line;
                   if ($line eq $ipx) {
                      print $sock "GZLINE *\@$line $bantime :$banreason\r\n";
                      print $sock "PRIVMSG $chan :GEFUNDEN! $line war in Blacklist!\r\n";
                      #print "<GZLINE *\@$line $bantime :$banreason\n\r";
                      #print "<PRIVMSG $chan :GEFUNDEN! $line war in Blacklist!\n\r";
                      last;
                   };
             };
             close($handle);
          };
       };
    };
    if ($line[1] eq "PRIVMSG") {
        if ($line[2] eq $nick) {
                print "$_\n";
                my $snick = &getnick($line[0]);
                if (&ifop($snick,@opers) == 1) {
                        #Idle Mode - Scans auf IP werden nicht durchgeführt
                        if ($line[3] eq ":idlemode") {
                                if (($line[4] eq "on") && ($idlemode == 0)) {
                                        $idlemode = 1;
                                        my $n = $nick . "-idlemode";
                                        print $sock "NICK :$n\r\n";
                                        print "NICK :$n\n";
                                        $nick = $n;
                                        print $sock "PRIVMSG $chan :$snick aktivierte IDLE-MODE, Scans werden ausgesetzt.\r\n";
                                        #print "PRIVMSG $chan :$snick aktivierte IDLE-MODE, Scans werden ausgesetzt.\n";
                                };
                                if (($line[4] eq "off") && ($idlemode == 1)) {
                                        $idlemode = 0;
                                        print $sock "NICK :$oldnick\r\n";
                                        print "NICK :$oldnick\n";
                                        $nick = $oldnick;
                                        print $sock "PRIVMSG $chan :$snick deaktivierte IDLE-MODE, Scans werden wieder aufgenommen.\r\n";
                                        #print "PRIVMSG $chan :$snick deaktivierte IDLE-MODE, Scans werden wieder aufgenommen..\n";
                                };
                        };
                        #shutdown Befehl - Fährt Bot herunter
                        if ($line[3] eq ":shutdown") {
                                if (defined $line[4]) {
                                        my $x = scalar @line;
                                        $x = $x - 1;
                                        print $sock "PRIVMSG $chan :$snick befahl Shutdown des Bots: @line[4..$x]\r\n";
                                        print $sock "QUIT :$snick SHUTDOWN: @line[4..$x]\r\n";
                                        close($sock);
                                        die;
                                } else {
                                        my $x = scalar @line;
                                        print $sock "PRIVMSG $chan :$snick befahl Shutdown des Bots.\r\n";
                                        print $sock "QUIT :$snick SHUTDOWN: no reason\r\n";
                                        close($sock);
                                        die;
                                };
                        };
                        #löschen eines Eintrages aus der Liste
                        if (($line[3] eq ":remove") && (defined $line[4])) {
                                open my $handle1, '<', $srcpath or die "Cant open File: $!";
                                my @list;
                                my $search = "$line[4]";
                                print Dumper($search);
                                while (my $x = <$handle1>) {
                                        chomp $x;
                                        if ($x ne $search) {
                                                push @list, $x;
                                                print "$x";
                                        };
                                };
                                print "AAAA @list";
                                close ($handle1);
                                open my $handle2, '>', $srcpath or die "Cant open File: $!";
                                foreach my $o (@list) {
                                        print $handle2 "$o\n";
                                };
                                close($handle2);
                        };

                };
        };
    };
};
#Subroutine zum Rausfischen von Nick aus :Nick!ident@host
sub getnick {
        my @x = split /!/, $_;
        my @y = split /:/, $x[0];
        return $y[1];
};
#Subroutine zur Prüfung ob der Nick ein Operator ist (&ifop(nick,@opers))
sub ifop {
        my $x = $_[0];
        my @o = @_;
        my $z = scalar @o;
        $z = $z - 1;
        foreach (@o[1..$z]) {
                if ($_ eq $x) {
                        return 1;
                };
        };
};


Hierbei eingehender Text, also inhalt von <$sock>:
:seraphim!seraph@Testserver-3A93D94C PRIVMSG Prsc :remove 127.0.0.1\r\n
Linuxer
 2008-06-15 23:10
#111049 #111049
User since
2006-01-27
3891 Artikel
HausmeisterIn

user image
edit1: bei den Variablen verlesen; Antwort gelöscht, weil fehlerhaft

edit2: neuer Versuch:

Mir scheint, dass der Umbruch in $srcpath nicht dem Wert innerhalb von $/ entspricht, wodurch das chomp($x) nicht greifen kann, weil $x immer noch den Zeilenumbruch enthält.

Damit kann $search (kein Umbruch) niemals equal $x sein.


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

                if ( ( $line[3] eq ":remove" ) && ( defined $line[4] ) ) {
                    open my $handle1, '<', $srcpath or die "Cant open File: $!";
                    my @list;
                    my $search = "$line[4]";
                    print Dumper($search);
                    while ( my $x = <$handle1> ) {
                        # VORSICHT HIER; PRUEFE mal den INHALT VON $x
                        chomp $x;
                        if ( $x ne $search ) {
                            push @list, $x;
                            # WO KOMMT DER UMBRUCH HER?
                            print "$x";
                        }
                    }
                    print "AAAA @list";
                    close($handle1);
                    open my $handle2, '>', $srcpath or die "Cant open File: $!";
                    foreach my $o (@list) {
                        print $handle2 "$o\n";
                    }
                    close($handle2);
                }
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!
betterworld
 2008-06-16 00:18
#111054 #111054
User since
2003-08-21
2614 Artikel
ModeratorIn

user image
seraphim+2008-06-15 20:31:33--
hmm das sind nur ca 170 zeilen, und da was drum rum zu bauen ist naja ^^

und Nachspielen wird für welche ohne ircD recht schwer teilweise


Oh Mann. Ich verstehe echt nicht, warum einige das Konzept von "Script zur Fehlersuche herunterkuerzen" nicht verstehen.
Drehen wir es mal um. Ich kuerze Dein Script so weit herunter, dass der Fehler gerade noch enthalten ist. Das Tolle daran ist dann, dass man keinen ircD und kein Netzwerk mehr braucht, um es auszufuehren:

Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
my $input = ":seraphim!seraph\@Testserver-3A93D94C PRIVMSG Prsc :remove 127.0.0.1\r\n";
my @line = split ' ', $input;
chomp @line;
local $/ = "\r";
chomp @line;

my $search = $line[4];

my @file = ("line1\n", "127.0.0.1\n");
for my $x (@file) {
    chomp $x;
    if ($x ne $search) {
        print "($x)\n";
    }
}


So, jetzt kannst Du weitermachen mit der Fehlersuche. Ich gebe Dir einen Tipp: Kuerze das Script noch weiter. Spiel damit rum, bis die 127.0.0.1 nicht mehr ausgegeben wird.

Naja, aber Linuxer hat es eigentlich schon verraten.

Fuer's naechste Mal: Bitte erst so weit kuerzen, dann posten.
Lieblingsmodule: CPAN:IPC::System::Simple, CPAN:Path::Class
seraphim
 2008-06-16 21:37
#111087 #111087
User since
2008-06-15
5 Artikel
BenutzerIn
[default_avatar]
ah danke linuxer ^^
local $/ = "\n"; hat geholfen ^^
<< >> 10 Einträge, 1 Seite



View all threads created 2008-06-15 17:48.