Netzer.pl

Hintergrund

Da die Kommunikation für mich (quabla) das war, was mich am meisten vom Schreiben eines Bots abgehalten hat, weil ich davon einfach keine Ahnung hatte, möchte ich mein Werk jetzt hier zur Verfügung stellen. Falls es noch jemandem so geht, dann kann er sich diesen Teil schonmal sparen, und braucht sich bloß um den eigentlichen Bot zu kümmern.

Das ganze Ding ist in perl geschrieben, und ich bin alles andere als ein perl-Experte. Wenn ihr also in irgendeiner Form nicht damit einverstanden seid: ruhig meckern!

Die Kommunikation läuft über die libwww-perl(LWP).

Netzer-Logik

netzer.pl schreibt für jedes Spiel von der dranbin-Seite eine Datei mit Namen spielnummer.dran, der Inhalt sollte selbsterklärend sein:

 Ich bin dran bei 3306.
 ZZZ=2, checkpoints aktiviert, crashen nicht erlaubt
 meine Position: x=29, y=65
 Die Positionen aller 1 Spieler:
 tester steht auf  x=29, y=65
 meine 8 Zugmoeglichkeiten:
 1) nach x=29, y=66 mit Vektor (0|1)
 2) nach x=29, y=67 mit Vektor (0|2)
 3) nach x=30, y=65 mit Vektor (1|0)
 4) nach x=30, y=66 mit Vektor (1|1)
 5) nach x=30, y=67 mit Vektor (1|2)
 6) nach x=31, y=65 mit Vektor (2|0)
 7) nach x=31, y=66 mit Vektor (2|1)
 8) nach x=31, y=67 mit Vektor (2|2)
 

Der eigentliche Bot sollte also diese Datei auswerten, und mit seinem Zug im Format

 
 vec 0 3
 

überschreiben.

netzer.pl

 #!/usr/bin/perl -w
 
 use strict;
 
 use LWP;
 use HTML::Form;
 use HTTP::Cookies;
 use Fcntl qw(:DEFAULT :flock);
 
 #
 #          parameters
 #
 
 #user
 my $username = "username";
 my $password = "passwort";
 
 # URLs
 my $URL_login   = 'http://karopapier.beididi.de/anmelden.php';
 my $URL_dranbin = 'http://karopapier.beididi.de/showgames.php?dranbin=1';
 my $URL_showmap = 'http://karopapier.beididi.de/showmap.php?GID=';
 my $URL_move    = 'http://karopapier.beididi.de/move.php?GID=';
 my $URL_mapsource='http://karopapier.beididi.de/mapsource.php?mapid=';
 my $URL_log     = 'http://karopapier.beididi.de/logs/';
 
 my $print = 1;
 my $sleep = 30;           # Zeit zwischen dranbin-abfragen in s
 my $sleep_error = 600;    # Wartezeit nach Fehler
 
 #
 #         start and login
 #
 
 # new browser
 my $browser = LWP::UserAgent->new;
 # with cookies
 $browser->cookie_jar({});
 
 
 # load login page
 my $request = HTTP::Request->new(GET => $URL_login);
 my $response;
 my $success;
 $success = 0;
 LOGIN: do {
   $response = $browser->request($request);
   if ($response->is_success) {
     #print $response->content,  "\n\n\n\n";
     if ($response -> content =~ m/Anmeldung/) {
       ;
     } else {
       print STDERR "Loginseite geladen, aber Auswertung gescheitert!\n";
       print STDERR "schlafe fuer $sleep_error Sekunden!\n";
       sleep $sleep_error;
       next LOGIN;
     }
   } else {
     print STDERR "login page problem\n";
     print STDERR $response->status_line, "\n";
     print STDERR "schlafe fuer $sleep_error Sekunden!\n";
     sleep $sleep_error;
     next LOGIN;
   }
 
   #get form
   my $form = HTML::Form->parse($response);
   #print $form->param;
 
   #login
   $form->value( "ID", $username );
   $form->value( "PWD", $password );
   $request = $form->click;
   $response = $browser->request($request);
   if ($response->is_success) {
     #print $response->content, "\n\n\n\n";
     if ($response->content =~ 
 	m/Du bist jetzt als <B>$username<\/B> angemeldet/) {
       $success = 1;
     } else {
     print STDERR "Anmeldung fehlgeschlagen!\n";
     print STDERR "schlafe fuer $sleep_error Sekunden!\n";
     sleep $sleep_error;
     next LOGIN;
     }
   } else {
     print STDERR "Anmeldung fehlgeschlagen!\n";
     print STDERR $response->status_line, "\n";
     print STDERR "schlafe fuer $sleep_error Sekunden!\n";
     sleep $sleep_error;
     next LOGIN;
   }
 } until ($success == 1);
 
 if ($print == 1) {
   print "login erfolgreich!\n";
 }
 
 #
 #        endless loop
 #
 
 ENDLESS: while() {
 
   if ($print==1) {print "------------------------------------\n";}
 
   #
   #  Spiele ermitteln
   #
 
   # get dranbin
   $request ->uri($URL_dranbin);
   $response = $browser->request($request);
   if ($response->is_success) {
     #print $response->content, "\n\n\n\n";
   } else {
     print STDERR $response->status_line, "\n";
     print STDERR "Laden der dranbin Seite fehlgeschlagen!\n";
     print STDERR "schlafe fuer $sleep_error Sekunden!\n";
     sleep $sleep_error;
     next ENDLESS;
   }
 
   my $spiel;
   my @spiele;
   foreach my $line (split(/\n/, $response->content)) {
     if ($line =~ m/showmap.php\?GID=(\d+)&pixel=10&karoborder=1>$/) {
       push @spiele, $1;
     }
   }
 
 
   if ((scalar(@spiele == 0)) && ($print == 1)) {
     print "Nix los - schlafe fuer $sleep Sekunden ... \n";
   }
 
   #
   #  Spiele abarbeiten
   #
 
  GAMES: foreach my $spiel (@spiele) {
 
     my $file = "$spiel.dran";
 
     # muss ein Auftrag erteilt werden?
     my $doit = 1;
 
     my $line;
 
     if ((-e $file) && (open (HANDLE, "<$file"))) {
 
       $line = <HANDLE>;
       if ($line =~m/(start|vec)/) {
 	
 	#
 	# Zug vorhanden
 	#
 	
 	$doit = 0;
 
 	$line =~m/(start|vec)\s+(-?\d+)\s+(-?\d+)/;
 
 	my $x = $2;
 	my $y = $3;
 	my $is_start=0;
 	if ($1 eq "start") {
 	  $is_start=1;
 	}
 	
 	if ($print == 1) {
 	  print "Zug gefunden fuer Spiel $spiel:\n";
 	  if ($is_start == 1) {
 	    print " Startzug nach ($x|$y)\n";
 	  } else {
 	    print "Vektor $x, $y\n";
 	  }
 	}
 
 	#do move
 	if ($is_start == 1) {
 	  $request->uri("$URL_move$spiel&startx=$x&starty=$y");
 	} else {
 	  $request->uri("$URL_move$spiel&xvec=$x&yvec=$y");
 	}
 	$response = $browser->request($request);
 	if ($response->is_success) {
 	  #   print $response->content, "\n\n\n\n";
 	} else {
 	  print STDERR "Zug fuer Spiel $spiel konnte nicht ausgefuehrt werden!\n";
 	  print STDERR $response->status_line, "\n";
 	  close (HANDLE);
 	  next GAMES;
 	}
 	
 	close (HANDLE);
 	open (HANDLE, ">$file");
 	print HANDLE "leer!";
 	close HANDLE;
       } elsif ($line =~ m/Ich bin dran/) {
 
 	# denkt noch!
 	if ($print ==1) {
 	  print "denker denkt noch bei Spiel $spiel...\n";
 	}
 	$doit = 0;
 	close HANDLE;
       }
 
     } # if (-e $file)...
 
     if ($doit == 1) {
 
       # ich bin dran, es liegt kein fertiger Zug vor, und es ist noch kein Suchauftrag erteilt
 
       $request->uri("$URL_showmap$spiel");
       $response = $browser->request($request);
       if ($response->is_success) {
 	# print $response->content, "\n\n\n\n";
       } else {
 	print STDERR "Laden der Seite von Spiel $spiel fehlgeschlagen!\n";
 	print STDERR $response->status_line, "\n";
 	next GAMES;
       }
 
       # is it the first move?
       my $is_start = 0;
       if ($response->content =~ m/Das Spiel fängt an: Bitte wähle Deine Startposition/) {
 	$is_start = 1;
       }
 
       my @moves;
       my $nmoves=0;
       my %position;
       my $self_found = 0;
       foreach my $line (split(/\n/, $response->content)) {
 
 	# get moves
 	if ($is_start == 0) {
 	
 	  if ($line =~ m/coords=\"(\d+),(\d+),\d+,\d+\"\s*href=\"move.php\?GID=$spiel&xvec=(-?\d+)&yvec=(-?\d+)/){
 	    $nmoves++;
 	    $moves[$nmoves]{'x'} = $1 / 11;
 	    $moves[$nmoves]{'y'} = $2 / 11;
 	    $moves[$nmoves]{'vx'} = $3;
 	    $moves[$nmoves]{'vy'} = $4;
 	  }
 	} else {
 
 	  if ($line =~ m/coords=\"(\d+),(\d+),\d+,\d+\"\s*href=\"move.php\?GID=$spiel&startx=(-?\d+)&starty=(-?\d+)/){
 	    $nmoves++;
 	    $moves[$nmoves]{'x'} = $1 / 11;
 	    $moves[$nmoves]{'y'} = $2 / 11;
 	    $moves[$nmoves]{'vx'} = 0;
 	    $moves[$nmoves]{'vy'} = 0;	
 	  }
 	}
 	
 	#get player positions
 	if ($line =~ m/coords=\"(\d+),(\d+),\d+,\d+\"\s*href=\"userinfo.php\?about=\d+\"\s*TITLE=\"(.*)\"/) {
 	  $position{$3}{'x'} = $1 / 11;
 	  $position{$3}{'y'} = $2 / 11;
 	  if ($3 eq $username) {
 	    $self_found = 1;
 	  }
 	}
 
       } # foreach $line
 
       # error?
       if (($self_found == 0) && ($is_start == 0)) {
 	print STDERR  "irgendwas laeuft schief: ich finde mich nicht, aber es geht auch nicht um Startplatzwahl!\n";
 	next GAMES;
       }
 	
       #
       # checkpoints, ZZZ, TC:
       # eigener browser ohne kekse,
       # da bei startzug nicht angezeigt wenn 'dran'
       # (bug in didis seite...)
       #
 
       # new browser
       my $browser1 = LWP::UserAgent->new;
       my $request1 = HTTP::Request->new(GET => "$URL_showmap$spiel");
       my $response1 = $browser1->request($request1);
 
       if ($response1->is_success) {
 #	print $response1->content, "\n\n\n\n";
       } else {
 	print STDERR "Laden der Seite von Spiel $spiel fehlgeschlagen!\n";
 	print STDERR $response1->status_line, "\n";
 	next GAMES;
       }
 
       my $ZZZ= 2;
       my $checkpoints = "aktiviert";;
       my $crash = "";
 
       foreach my $line (split(/\n/, $response1->content)) {
 #	print "$line\n";
 	if ($line =~ m/Spielinfos:/) {
 #	  print $line;
 	  $line =~m/ZZZ steht auf (\d+). Checkpoints sind (deaktiviert|aktiviert). Taktisches Crashen ist (<B>)?(nicht|)\s*erlaubt/;
 	  $ZZZ = $1;
 	  $checkpoints = $2;
 	  $crash = $4;
 #	  print "\n$ZZZ $checkpoints $crash\n";
 	}
       }
 
       #
       #        get map
       #
 
       my $mapID = -1;
       if ((!(-e "$spiel.map")) || ($is_start)) {
 
 	#get map ID from logfile
 
 	#get logfile
 	$request->uri("$URL_log$spiel.log");
 	# ich hab keine Ahnung warum, aber hier muss GET gesetzt 
 	# werden, sonst spuckt er.
 	$request->method('GET');
 	$response = $browser->request($request);
 	if ($response->is_success) {
 	  #   print $response->content, "\n\n\n\n";
 	} else {
 	  print STDERR "kann logfile fuer spiel $spiel nicht laden!\n";
 	  print STDERR $response->status_line, "\n";
 	  next GAMES;
 	}
 	foreach my $line (split(/\n/, $response->content)) {
 	  if ($line =~ m/.*Spiel.*Map (\d+) von .* erstellt/) {
 	    $mapID = $1;
 	  }
 	}
 	if ($mapID == -1) {
 	  print STDERR "konnte die map fuer Spiel $spiel nicht ermitteln!\n";
 	  next GAMES;
 	}
 
 	#get map
 	$request->uri("$URL_mapsource$mapID");
 	$response = $browser->request($request);
 	if ($response->is_success) {
 	  #         print $response->content, "\n\n\n\n";
 	} else {
 	  print STDERR "konnte die Karte fuer Spiel $spiel nicht laden!\n";
 	  print STDERR $response->status_line, "\n";
 	  next GAMES;
 	}
 	
 	open (HANDLE, ">$spiel.map") ||die "kann $spiel.map nicht oeffnen!\n";
 	print HANDLE $response->content;
 	close HANDLE;
       }
 
 
       # print what we got!
       if ($print == 1) {
 	print "Ich bin dran bei $spiel.\n";
 	print  "ZZZ=$ZZZ, checkpoints $checkpoints, crashen $crash erlaubt\n";
 	if ($is_start == 1) {
 	  print "Startzug!\n";
 	}
 	if ($self_found == 1) {
 	  print "meine Position: x=$position{$username}{'x'}, y=$position{$username}{'y'}\n";
 	}
 	print "Die Positionen aller ",scalar(keys(%position))," Spieler:\n";
 	foreach my $name (keys %position) {
 	  print "$name steht auf  x=$position{$name}{'x'}, y=$position{$name}{'y'}\n";
 	}
 	print "meine $#moves Zugmoeglichkeiten:\n";
 	foreach my $i (1.. $#moves) {
 	  print "$i) nach x=$moves[$i]{'x'}, y=$moves[$i]{'y'} mit Vektor ($moves[$i]{'vx'}|$moves[$i]{'vy'})\n";
 	}
       }
 
       #
       #    print to file:
       #
 
       open (HANDLE, ">$spiel.dran") ||die "kann $spiel.dran nicht oeffnen!\n";
       flock(HANDLE, LOCK_EX) ||die "kann $spiel.dran nicht locken!\n";
       select HANDLE;
       print "Ich bin dran bei $spiel.\n";
       print HANDLE "ZZZ=$ZZZ, checkpoints $checkpoints, crashen $crash erlaubt\n";
       if ($is_start == 1) {
 	print "Startzug!\n";
       }
       if ($self_found == 1) {
 	print "meine Position: x=$position{$username}{'x'}, y=$position{$username}{'y'}\n";
       }
       print "Die Positionen aller ",scalar(keys(%position))," Spieler:\n";
       foreach my $name (keys %position) {
 	print "$name steht auf  x=$position{$name}{'x'}, y=$position{$name}{'y'}\n";
       }
       print "meine $#moves Zugmoeglichkeiten:\n";
       foreach my $i (1.. $#moves) {
 	print "$i) nach x=$moves[$i]{'x'}, y=$moves[$i]{'y'} mit Vektor ($moves[$i]{'vx'}|$moves[$i]{'vy'})\n";
       }
       flock(HANDLE, LOCK_UN) ||die "kann $spiel.dran nicht unlocken!\n";
       close HANDLE;
       select STDOUT;
 
     } # if ($doit ==1)
 
   } # loop games
 
   sleep $sleep;
 
 } # end ENDLESS