Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Netzwerkprogrammierung und Netzwerke mit Perl
[thread]4469[/thread]

Problem mit WWW::Mechanize: oder was anderem ;) (Seite 2)



<< |< 1 2 >| >> 19 Einträge, 2 Seiten
FlorianL
 2007-07-02 16:37
#37591 #37591
User since
2007-05-18
142 Artikel
BenutzerIn
[default_avatar]
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

sub heal {
        my $pro = shift;
        $agent->get("http://$url/index.php?act=atkshop");
        my ($money) = $agent->content =~ m/Euro:<\/strong> (\d+(?:,\d+)?)/;
        my ($s_potions) = $agent->content =~ m/.+>War Pills \((\d+)\)</;
        print("Money: $money \| Small Potions: $s_potions\n");
        if ($pro == '50') {
               
 print("Got 50 percent\n");
               
 if ($s_potions > 1) {
               
         print gettime(), "Using small Potion\n";
               
         $agent->get("http://$url/index.php?act=atkshop&do=use&item=1");
               
 } elsif (($s_potions == 0) and ($money > 125)) {
               
         print gettime(), "Buying small Potion\n";
               
         $agent->get("http://$url/index.php?act=atkshop&do=buy&item=1");
               
         print gettime(), "Using small Potion\n";
               
         $agent->get("http://$url/index.php?act=atkshop&do=use&item=1");
               
 } elsif (($s_potions == 0) and ($money < 125)) {
               
         print gettime(), "No Money, No Potions, sleeping...\n";
               
         goto SLEEP;
               
 }
        } elsif ($pro == '25') {
               
         print("Got 25 percent\n");
               
         if ($s_potions > 1) {
               
         print gettime(), "Using small Potion\n";
               
         $agent->get("http://$url/index.php?act=atkshop&do=use&item=1");
               
 } elsif (($s_potions == 0) and ($money > 125)) {
               
         print gettime(), "Buying small Potion\n";
               
         $agent->get("http://$url/index.php?act=atkshop&do=buy&item=1");
               
         print gettime(), "Using small Potion\n";
               
         $agent->get("http://$url/index.php?act=atkshop&do=use&item=1");
               
 } elsif (($s_potions == 0) and ($money < 125)) {
               
         print gettime(), "No Money, No Potions, sleeping...\n";
               
         goto SLEEP;
               
 }
        }
}


wird das mit dem matchen so funktionieren? ich habe im kopf das ich das samstag nacht mal probiert habe, aber andauernd 0 rauskam?!

ach, ist jetz auch blöd so ohne testen... ich schau's mir heut nachmittag nochma an wenn der server wieder erreichbar ist..
renee
 2007-07-02 16:40
#37592 #37592
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Ich persönlich verwende ganz gerne CPAN:YAML::Tiny

test.yml:
Code: (dl )
1
2
3
---
user: beispieluser
max_files: 19


Skript:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14

#!/usr/bin/perl

use strict;
use warnings;
use YAML::Tiny;

my $file = 'test.yml';

my %config = %{ YAML::Tiny->read( $file )->[0] };

print qq~
Database user: $config{user}
Maximum files: $config{max_files}
~;
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
 2007-07-02 16:43
#37593 #37593
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Keine Ahnung, ob das mit dem Matchen so klappt. Ich weiß ja nicht, was in $agent->content steht...
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/
FlorianL
 2007-07-02 16:57
#37594 #37594
User since
2007-05-18
142 Artikel
BenutzerIn
[default_avatar]
Ich hab mir eben yaml mal angesehn und es gefällt mir nicht...

ich hab keine logische erklärung die dagegen spricht, mir gefällt der aufbau einfach nicht ;)

hätte lieber ne standart wald-und-wiesen config like

# Willst du den guild-mode nutzen?
# wenn ja guild 1
# wenn nein guild 0
guild 1

wenn ich das nun per regex machn will brauch ich doch nurnoch lustig drauf los matchen

open(FILE,$config);
my @config = <FILE>;
if ((@config =~ m/^guild.(\d)/) eq "1") {
print "ich benutze guildmode";
} else { print "kein guildmode";
}


und $agent->content beinhaltet natürlich den htmlcode, das worauf ich matchen will sollte ">War Pills </strong>(20)<" z.B so aussehn

match wär dann m/.+>War Pills.+\(\d\)</

rüschtög? :)

edit: nein halt, müsste dann foreach (@config) { usw.

naaaja, egal jetz, ich fummel wie gesagt ersma weiter dran rum, und wenns garnich mehr klappt komm ich nochma ;)

aber wie ich goto und die labels austausche ist mir gerad nich so bewusst... hmmm müsste dann alles über bedingungen machen right?

aber im fall von meinem fork'ed health-watcher.. kann ich aus der sub heraus wieder die sub aufrufen? hab ich ehrlich gesagt noch nie getestet :)

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

sub healthwatch {
        logmein();
        if ($watchlog == '1') { print gettime(), "Checking if we need a Potion\n"; }
        healcheck();
        sleep($watchdelay);
        healthwatch();
}


dann hab ich das prob das er jedes mal einloggt obwohl die session noch nicht abgelaufen ist...

ach is das immer ein rattenschwanz hier :P\n\n

<!--EDIT|FlorianL|1183382271-->
renee
 2007-07-02 17:22
#37595 #37595
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Das .+ vor WarPills brauchst Du nicht...

Vielleicht gefällt Dir der .ini-Style ja besser:

test.ini
Code: (dl )
1
2
3
[config]
user=beispieluser
max_files=19


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

#!/usr/bin/perl

use strict;
use warnings;
use Config::IniFiles;

my $file = 'test.ini';

tie my %hash, 'Config::IniFiles', (-file => $file );
my %config = %{ $hash{config} };

print qq~
Database user: $config{user}
Maximum files: $config{max_files}
~;
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
 2007-07-02 17:26
#37596 #37596
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Ein
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13

#!/usr/bin/perl

use strict;
use warnings;

$|++;

my $counter = 0;

START:
  print ++$counter,"\r";
  sleep 1;
  goto START;
kannst Du ersetzen durch
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13

#!/usr/bin/perl

use strict;
use warnings;

$|++;

my $counter = 0;

while(1){
  print ++$counter,"\r";
  sleep 1;
}
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/
FlorianL
 2007-07-03 01:19
#37597 #37597
User since
2007-05-18
142 Artikel
BenutzerIn
[default_avatar]
sooo :)

hab jetzt mal auf Config::ini umgestellt nachdem ich gelesen hatte das # als comment aktzeptiert wird, mehr wollt ich ja garnicht ;)

ausserdem hab ich nun alles in subs verpackt wie du mir geraten hast, nun hab ich wieder mal das problem

Quote
Bareword "prozente" not allowed while "strict subs" in use at battlebot.txt line 142.
Bareword "prozente" not allowed while "strict subs" in use at battlebot.txt line 142.
Bareword "prozente" not allowed while "strict subs" in use at battlebot.txt line 142.
Execution of battlebot.txt aborted due to compilation errors.


das selbe dann auch bei den anderen subs :(

mein 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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251

#!/usr/bin/perl
#
# ibProBattle Bot
#  (c) Mindfuck 2007
#    www.mindfucked.org
#
#  This Bot automates the Invision Power Board -Board Game ibP-Battle
#
#  Features & HowTo: rtfm!
#
#######################
use strict;
use warnings;
use WWW::Mechanize;
use HTML::TokeParser;
use HTTP::Cookies;
use Term::ANSIColor;
use Config::IniFiles;
############################## CONFIG #########################################

my $configfile = 'battlebot.ini';

tie my %hash, 'Config::IniFiles', (-file => $configfile );
my %config = %{ $hash{config} };

my @friends = (10202,7222);

################# NO NEED TO EDIT BELOW THIS LINE #############################
my $agent = WWW::Mechanize->new();
$agent->cookie_jar(HTTP::Cookies->new);
my $count = '1';
our $stop = '0';
my $version = "0.2b";

sub gettime{
    return sprintf "%s:%s:%s ", (localtime)[2,1,0];
}

sub randomizer {
        my $seconds = shift;
    my $rand_number = int(rand($config{spread}));
    my $twisted = ($seconds + $rand_number);
    return $twisted;
}

sub timer {
        my $minutes = shift;
    my $seconds = ($minutes * 60);
    my $magic = randomizer($seconds);
    print gettime(), "Sleeping for $minutes minutes\n";
    sleep($magic);
}

sub id2nick {
    my $id = shift;
    $agent->get("http://$config{url}/index.php?showuser=$id");
    my $nick = $agent->content =~ m/<title>(.+) - Profil ansehen<\/title>/;
    my $dood = $1;
    return $dood;
}

sub logmein {
    CONNECT:
    if ($config{DEBUG} == '1') { print("DEBUG: Accessing $config{url}\n");}
        $agent->get("http://$config{url}/index.php?act=Login&CODE=00");
        $agent->success or (sleep(600) and (goto CONNECT));
        $agent->form_name('LOGIN') or goto SLEEP;
        $agent->field('UserName',$config{username});
        $agent->field('PassWord',$config{password});
    if ($config{DEBUG} == '1') { print("DEBUG: Logging in...\n");}
        $agent->submit();
    print("Send User\/Pass to $config{url}\n");
}


sub getinfo {
    my $input = shift;
    $agent->get("http://$config{url}/index.php?act=atkshop");
    my $infopage = $agent->content;
    my $money = $infopage =~ m/Euro:<\/strong> (\d+(?:,\d+)?)/;
    my $s_potions = $infopage =~ m/.+>War Pills \((\d+)\)</;
    if ($input eq "money") {
        return $money;
    } elsif ($input eq "s_potions") {
        return $s_potions;
    }
}

sub attack {
    $agent->get("http://$config{url}/index.php?act=atkshop&do=target");
        my @targetsite = $agent->content;
    if ($config{DEBUG} == '1') { print("DEBUG: Parsing Victims...\n");}
    my @targets;
    foreach (@targetsite) {
        push @targets, $_ =~ m/act=attack&m=(\d+)/gs;
    }
    if ($config{DEBUG} == '1') { print ("DEBUG: Found Target: @targets\n");}
    if ($config{DEBUG} == '1') { print("DEBUG: Attacking...\n");}
        foreach (@targets) {
               
 my $target = $_;
               
 $agent->get("http://$config{url}/index.php?act=attack&m=$target");
        if ($config{DEBUG} == '1') { print("DEBUG: Choosing best Weapon...\n");}
               
 my @weaponlist = $agent->content =~ m/.+&w=(\d)/;
               
 my @weapons = sort(@weaponlist);
               
 if ((defined $weapons[0]) and ($stop == '0') and ($target != @friends)) {
            if ($config{DEBUG} == '1') { print("DEBUG: Attack \#$count\n");}
               
         $agent->get("http://$config{url}/index.php?act=attack&m=$target&w=$weapons[0]");
               
         print gettime(), "\#$count $config{username} Attacked Target id ", id2nick($target), " with Weapon $weapons[0]\n";
               
         $count++;
            healcheck();
               
 } else {
               
         print gettime(), "Cant attack ", id2nick($_), " \(Id: $_\), moving on to next Victim\n";
               
 }
               
 if ($count == $config{max_attacks}) {
               
         print gettime(), "Attacked $config{max_attacks} Targets, stopping...\n";
            healcheck();
               
         goto SLEEP;
               
 }
        }
    if ($config{DEBUG} == '1') { print("DEBUG: Attack finished\n");}
}

sub gethp {
    my $input = shift;
    $agent->get("http://$config{url}/index.php?act=atkshop&do=target");
    my @hpmaxhp = $agent->content =~ m/.+<strong>Hp: <\/strong> (\d+)\/(\d+)/;
    my $hp = $hpmaxhp[0]; my $maxhp = $hpmaxhp[1];
    my $prozente = $hp * 100 / $maxhp;
    if ($input eq "hp") {
        return $hp;
    } elsif ($input eq "maxhp") {
        return $maxhp;
    } elsif ($input eq "prozente") {
        return $prozente;
    }
}

sub healcheck {
    if ($config{DEBUG} == 1) {
        print gettime(), "DEBUG: Checking if we need a Potion\n";
    }
    if (gethp(prozente) == 0) {
        if ($config{DEBUG} == '1') { print("DEBUG: Im Dead!\n");}
        my $deathsleep = ($config{deathtimer} * 60);
        print gettime(), "!!!YOU ARE DEAD!!!\n";
        print gettime(), "Sleeping for $config{deathtimer} minutes\n";
        sleep($deathsleep);
        goto START;
    } elsif (gethp(prozente) < 25) {
        if ($config{DEBUG} == 1) { print("DEBUG: Health below 25%, trying to use middle potion.\n");}
        heal("25");
    } elsif (gethp(prozente) < 55) {
        if ($config{DEBUG} == 1) { print("DEBUG: Health below 55%, trying to use small potion.\n");}
        heal("50");
    }
}

sub heal {
    my $pro = shift;
    print color("green"), "Money:", getinfo(money), "\nSmall Potions:", getinfo(s_potions), "\n", color("reset");
    if ($pro == '50') {
        print("Got 50 percent\n");
        if (getinfo(s_potions) > 1) {
            print gettime(), "Using small Potion\n";
            $agent->get("http://$config{url}/index.php?act=atkshop&do=use&item=1");
        } elsif ((getinfo(s_potions) == 0) and (getinfo(money) > 125)) {
            print gettime(), "Buying small Potion\n";
            $agent->get("http://$config{url}/index.php?act=atkshop&do=buy&item=1");
            print gettime(), "Using small Potion\n";
            $agent->get("http://$config{url}/index.php?act=atkshop&do=use&item=1");
        } elsif ((getinfo(s_potions) == 0) and (getinfo(money) < 125)) {
            print gettime(), "No Money, No Potions, sleeping...\n";
            goto SLEEP;
        }
        } elsif ($pro == '25') {
            print("Got 25 percent\n");
            if (getinfo(s_potions) > 1) {
            print gettime(), "Using small Potion\n";
            $agent->get("http://$config{url}/index.php?act=atkshop&do=use&item=1");
        } elsif ((getinfo(s_potions) == 0) and (getinfo(money) > 125)) {
            print gettime(), "Buying small Potion\n";
            $agent->get("http://$config{url}/index.php?act=atkshop&do=buy&item=1");
            print gettime(), "Using small Potion\n";
            $agent->get("http://$config{url}/index.php?act=atkshop&do=use&item=1");
        } elsif ((getinfo(s_potions) == 0) and (getinfo(money) < 125)) {
            print gettime(), "No Money, No Potions, sleeping...\n";
            goto SLEEP;
        }
    }
}

sub healthwatch {
    logmein();
    WATCHER:
    if ($config{watchlog} == '1') { print gettime(), "Checking if we need a Potion\n"; }
    healcheck();
    sleep($config{watchdelay});
    goto WATCHER;
}

sub info {
    print color("orange"), "Health: ", gethp(hp),"\/",gethp(maxhp),"\n", color("reset");
}

main {
    system("clear");
    if ($config{DEBUG} == '1') { print gettime(), "DEBUGGING STARTED\n\n";}
    print color("yellow"), "Mindfucks ipB Battle Bot version $version\n", color("reset");
    if ($config{healthwatcher} == '1') {
        if(! defined(my $pid= fork())){ die "Error on Fork\n";}
        elsif($pid==0){
            healthwatch();
        }
        else{
            START:
            logmein();
            info();
            healcheck();
            attack();
            if ($config{DEBUG} == '1') { print gettime(), "DEBUGGING ENDED\n";}
            SLEEP:
            timer($config{delay});
            goto START;
        }
    } else {
        START:
        logmein();
        info();
        healcheck();
        attack();
        if ($config{DEBUG} == '1') { print("DEBUGGING ENDED\n");}
        SLEEP:
        timer($config{delay});
        goto START;
    }
}


die ini:

Code: (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
[config]
#
# Mindfuck ipB Battlebot
#
# (c) 2007 www.mindfucked.org
#
##############################################


# Should we use Guild-Mode?
# That means, we wont attack Guild Members
# and maybe revive them in future Versions of Battlebot
guild=0

# Show Debug Output?
DEBUG=1

# Your ipB Username
username=hasskopf

# Your ipB Password
password=v6cpak

# The URL of ipB without http:// or a trailing / at the end...
url=usb.unitedsb.de

# Timer after each dead
deathtimer=60

# Should we check our Hp and use a Potion from time to time?
healthwatcher=0

# Delay between the Attacks
delay=151

# How much Attacks should we initiate?
max_attacks=5

# How often should the Healthwatcher check our Hp?
watchdelay=30

# Print out healthwatcher messages?
watchlog=0

# We randomize our timers a bit...
# 15 means, a random number between 1 and 15 is picked and added to our delay
spread=15


gude nacht ;)

edit:

Quote
Bareword "bareword" not allowed while "strict subs" in use at ...

Ironically, the second example contains the illegal bareword subs. It works because at the point Perl parses the pragma it is not yet in effect. Immediately afterwards, barewords are not permitted, so to switch off strict subs again we would have to use either quotes or a quoting operator like qw: no strict 'subs'; no strict q(subs); no strict qw(subs);

von hier

nur versteh ich das gerad nich so wirklich :blush:\n\n

<!--EDIT|FlorianL|1183414177-->
renee
 2007-07-03 10:39
#37598 #37598
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Dein Problem liegt hier:
Code (perl): (dl )
gethp(prozente)


Du willst vermutlich einen String übergeben, also muss es
Code (perl): (dl )
gethp('prozente')
heißen.
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/
FlorianL
 2007-07-03 10:41
#37599 #37599
User since
2007-05-18
142 Artikel
BenutzerIn
[default_avatar]
moin :)

nein das war mein fehler? wie dääämlich... :P

wenn das läuft werd ich das goto auswechseln, und dann darfste nochma kritik üben ;)
<< |< 1 2 >| >> 19 Einträge, 2 Seiten



View all threads created 2007-06-30 21:35.