X-Git-Url: https://ruin.nu/git/?a=blobdiff_plain;f=scripts%2Fscans.pl;h=fa27b0312fd1070fc4e76aea82f2b51bcdbc77e7;hb=a333f6b98536c67510e7a633740bbc986f0981ef;hp=756778ea8c3be35b6a1fb2b89cfbb4c6c068dff2;hpb=eba9c5a412c52fa67931561438ad9d5816f9067b;p=ndwebbie.git diff --git a/scripts/scans.pl b/scripts/scans.pl index 756778e..fa27b03 100755 --- a/scripts/scans.pl +++ b/scripts/scans.pl @@ -1,6 +1,6 @@ #!/usr/bin/perl #************************************************************************** -# Copyright (C) 2006 by Michael Andreen * +# Copyright (C) 2006,2007 by Michael Andreen * # * # This program is free software; you can redistribute it and/or modify * # it under the terms of the GNU General Public License as published by * @@ -21,242 +21,216 @@ use strict; use warnings; +no warnings 'exiting'; use CGI; use DBI; use DBD::Pg qw(:pg_types); use LWP::Simple; +use lib qw{/var/www/ndawn/}; +use ND::DB; -our $dbh; -for my $file ("/home/whale/db.pl") -{ - unless (my $return = do $file){ - warn "couldn't parse $file: $@" if $@; - warn "couldn't do $file: $!" unless defined $return; - warn "couldn't run $file" unless $return; - } -} +our $dbh = ND::DB::DB(); -$dbh->trace("3","/tmp/scanstest"); -$dbh->do("SET CLIENT_ENCODING TO 'LATIN1';"); +#$dbh->trace("1","/tmp/scanstest"); -my $scangroups = $dbh->prepare(q{SELECT scan_id,tick,scan FROM scans WHERE "type" = 'group' AND scan ~ '^-?[0-9]+$'}); +#my $test = $dbh->prepare(q{INSERT INTO scans (tick,scan_id) VALUES(1,3) RETURNING id}); +#print ; +$dbh->do(q{SET CLIENT_ENCODING TO 'LATIN1';}); + +my $scangroups = $dbh->prepare(q{SELECT id,scan_id,tick,uid FROM scans + WHERE groupscan AND NOT parsed FOR UPDATE +}); my $oldscan = $dbh->prepare(q{SELECT scan_id FROM scans WHERE scan_id = ? AND tick >= tick() - 168}); -my $addScan = $dbh->prepare(q{INSERT INTO scans (scan_id,tick,"type") VALUES (?,?,COALESCE(?,'-1'))}); -my $donegroup = $dbh->prepare(q{UPDATE scans SET "type" = 'donegroup' WHERE scan_id = ? AND "type" = 'group' AND tick = ?}); +my $addScan = $dbh->prepare(q{INSERT INTO scans (scan_id,tick,uid) VALUES (?,?,?)}); +my $parsedscan = $dbh->prepare(q{UPDATE scans SET tick = ?, type = ?, planet = ?, parsed = TRUE WHERE id = ?}); +my $addpoints = $dbh->prepare(q{UPDATE users SET scan_points = scan_points + ? WHERE uid = ? }); +my $delscan = $dbh->prepare(q{DELETE FROM scans WHERE id = ?}); -$scangroups->execute; +$scangroups->execute or die $dbh->errstr; -while (my @group = $scangroups->fetchrow){ - my $file = get("http://game.planetarion.com/showscan.pl?scan_grp=$group[0]"); +while (my $group = $scangroups->fetchrow_hashref){ + $dbh->begin_work; + my $file = get("http://game.planetarion.com/showscan.pl?scan_grp=$group->{scan_id}"); my $points = 0; while ($file =~ m/showscan.pl\?scan_id=(\d+)/g){ unless ($dbh->selectrow_array($oldscan,undef,$1)){ - $addScan->execute($1,$group[1],$group[2]); + $addScan->execute($1,$group->{tick},$group->{uid}); ++$points; } } - my $f = $dbh->prepare('UPDATE users SET scan_points = scan_points + ? WHERE uid = ? '); - $f->execute($points,$group[2]); - $donegroup->execute($group[0],$group[1]); + $addpoints->execute($points,$group->{uid}); + $parsedscan->execute($group->{tick},'GROUP',undef,$group->{id}); + $dbh->commit; } -my $emptyscans = $dbh->prepare('SELECT scan_id,tick,"type"::integer,tick() FROM scans WHERE planet is NULL AND type ~ \'^-?[0-9]+$\''); -my $update = $dbh->prepare('UPDATE scans SET tick = ?, "type" = ?, scan = ? , planet = ? WHERE scan_id = ? AND tick = ?'); -$addScan = $dbh->prepare('INSERT INTO scans (tick,scan_id,"type",scan,planet) VALUES($1,$2,$3,$4,$5)') or die $dbh->errstr; -my $findplanet = $dbh->prepare('SELECT planetid(?,?,?,?)'); -my $delscan = $dbh->prepare('DELETE FROM scans WHERE scan_id = ? AND tick = ?'); -unless ($emptyscans->execute){ - my $cleanup = $dbh->prepare('UPDATE scans SET "type" = \'-1\' WHERE planet is NULL'); - $cleanup->execute; - $emptyscans->execute; -} -while (my @scan = $emptyscans->fetchrow){ - my $file = get("http://game.planetarion.com/showscan.pl?scan_id=$scan[0]"); +my $newscans = $dbh->prepare(q{SELECT id,scan_id,tick,uid FROM scans + WHERE NOT groupscan AND NOT parsed FOR UPDATE +}); +my $findplanet = $dbh->prepare(q{SELECT planetid(?,?,?,?)}); +my $findoldplanet = $dbh->prepare(q{SELECT id FROM planet_stats WHERE x = $1 AND y = $2 AND z = $3 AND tick <= $4 ORDER BY tick DESC LIMIT 1}); +my $findcoords = $dbh->prepare(q{SELECT * FROM planetcoords(?,?)}); +my $addfleet = $dbh->prepare(q{INSERT INTO fleets (name,mission,sender,target,tick,eta,back,amount,ingal,uid) VALUES(?,?,?,?,?,?,?,?,?,-1) RETURNING id}); +my $fleetscan = $dbh->prepare(q{INSERT INTO fleet_scans (id,scan) VALUES(?,?)}); +my $addships = $dbh->prepare(q{INSERT INTO fleet_ships (id,ship,amount) VALUES(?,?,?)}); +my $addpdata = $dbh->prepare(q{INSERT INTO planet_data (id,tick,scan,rid,amount) VALUES(?,?,?,(SELECT id FROM planet_data_types WHERE category = ? AND name = ?), ?)}); + +$dbh->begin_work or die 'No transaction'; +$newscans->execute or die $dbh->errstr; +$dbh->pg_savepoint('scans') or die "No savepoint"; +while (my $scan = $newscans->fetchrow_hashref){ + my $file = get("http://game.planetarion.com/showscan.pl?scan_id=$scan->{scan_id}"); + next unless defined $file; if ($file =~ /((?:\w| )*) (?:Scan|Probe) on (\d+):(\d+):(\d+) in tick (\d+)/){ + eval { my $type = $1; my $x = $2; my $y = $3; my $z = $4; my $tick = $5; + + if($dbh->selectrow_array(q{SELECT * FROM scans WHERE scan_id = ? AND tick = ? AND id <> ?},undef,$scan->{scan_id},$tick,$scan->{id})){ + $dbh->pg_rollback_to('scans') or die "rollback didn't work"; + $delscan->execute($scan->{id}); + $addpoints->execute(-1,$scan->{uid}) if $scan->{uid} > 0; + die "Duplicate scan: $scan->{id} http://game.planetarion.com/showscan.pl?scan_id=$scan->{scan_id}\n"; + } my ($planet) = $dbh->selectrow_array($findplanet,undef,$x,$y,$z,$tick); unless ($planet){ - if ($scan[1] + 48 < $scan[3]){ - $delscan->execute($scan[0],$scan[1]); - } + $dbh->pg_rollback_to('scans') or die "rollback didn't work"; next; } my $scantext = ""; if ($file =~ /(Note: [^<]*)/){ - $scantext .= qq{ - - -
$1
}; + #TODO: something about planet being closed? } if ($type eq 'Planet'){ $file =~ s/(\d),(\d)/$1$2/g; - if($file =~ m/Metal\D+(\d+)\D+(\d+).+?Crystal\D+(\d+)\D+(\d+).+?Eonium\D+(\d+)\D+(\d+)/s){ - $scantext .= < - MetalCrystalEonium - Asteroids$1$3$5 - Resources$2$4$6 - -HTML - } - ; - my $f = $dbh->prepare("UPDATE covop_targets SET metal = ?, crystal = ?, eonium = ? WHERE planet = ?"); - if ($f->execute($2,$4,$6,$planet) < 1){ - $f = $dbh->prepare("INSERT INTO covop_targets (planet,metal, crystal, eonium) VALUES(?,?,?,?)"); - $f->execute($planet,$2,$4,$6); + while($file =~ m/"center">(Metal|Crystal|Eonium)\D+(\d+)\D+([\d,]+)/g){ + my ($roids,$res) = ($2,$3); + $roids =~ s/,//g; + $addpdata->execute($planet,$tick,$scan->{id} + ,'roid',$1, $roids) or die $dbh->errstr; + $res =~ s/,//g; + $addpdata->execute($planet,$tick,$scan->{id} + ,'resource',$1, $res) or die $dbh->errstr; + } + #if($file =~ m{"center">([^<]+)([^<]+)([^<]+)}){ + # $addpdata->execute($planet,$tick,$scan->{id} + # ,'planet','Light Usage', $1) or die $dbh->errstr; + # $addpdata->execute($planet,$tick,$scan->{id} + # ,'planet','Medium Usage', $2) or die $dbh->errstr; + # $addpdata->execute($planet,$tick,$scan->{id} + # ,'planet','Heavy Usage', $3) or die $dbh->errstr; + #} + if($file =~ m{([\d,]+)}){ + my $res = $1; + $res =~ s/,//g; + $addpdata->execute($planet,$tick,$scan->{id} + ,'planet','Production', $res) or die $dbh->errstr; } }elsif ($type eq 'Jumpgate'){ - $scantext .= < - - Coords - Mission - Fleet - Eta - Amount - -HTML - ; - my $f = $dbh->prepare("SELECT add_intel(?,?,?,?,?,?,?,?,?,?,-1)"); - my $i = 1; while ($file =~ m/(\d+):(\d+):(\d+)\D+"left"\>(Attack|Defend|Return)<\/td>([^<]*)<\/td>(\d+)\D+(\d+)/g){ - my $row = "odd"; - $row = "even" if ($i % 2 == 0); - if ($4 ne 'Return'){ - $f->execute($tick,$6,$x,$y,$z,$1,$2,$3,$7,$4);# or $server->command("echo " . DBI->errstr); - } - $scantext .= qq{ - $1:$2:$3$4$5$6$7}; - $i++; + + my ($sender) = $dbh->selectrow_array($findplanet,undef,$1,$2,$3,$tick) or die $dbh->errstr; + ($sender) = $dbh->selectrow_array($findoldplanet,undef,$1,$2,$3,$tick) if ((not defined $sender) && $4 eq 'Return'); + my $id = addfleet($5,$4,undef,$sender,$planet,$tick+$6,$6 + ,undef,$7, $x == $1 && $y == $2); + $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr; } - $scantext .= "\n"; }elsif ($type eq 'News'){ - $scantext .= "\n"; - my $i = 1; - my $cgi = new CGI; - my $f = $dbh->prepare("SELECT add_intel(?,?,?,?,?,?,?,?,?,?,-1)"); while( $file =~ m{top">((?:\w| )+)\D+(\d+)}g){ - my $row = "odd"; - $row = "even" if ($i % 2 == 0); - $i++; my $news = $1; my $t = $2; - my $text = $cgi->escapeHTML($3); - my $class = ''; - - if($news eq 'Launch' && $text =~ m/(?:[^<]*) fleet has been launched, heading for (\d+):(\d+):(\d+), on a mission to (Attack|Defend). Arrival tick: (\d+)/g){ - + my $text = $3; + my ($x,$y,$z) = $dbh->selectrow_array($findcoords,undef,$planet,$t); + die "No coords for: $planet tick $t" unless defined $x; + if($news eq 'Launch' && $text =~ m/The (.*?) fleet has been launched, heading for (\d+):(\d+):(\d+), on a mission to (Attack|Defend). Arrival tick: (\d+)/g){ + my $eta = $6 - $t; + my $mission = $5; + my $back = $6 + $eta; + $mission = 'AllyDef' if $eta == 6 && $x != $2; + my ($target) = $dbh->selectrow_array($findplanet,undef + ,$2,$3,$4,$t) or die $dbh->errstr; + die "No target: $2:$3:$4" unless defined $target; + my $id = addfleet($1,$mission,undef,$planet,$target,$6 + ,$eta,$back,undef, ($x == $2 && $y == $3)); + $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr; + }elsif($news eq 'Incoming' && $text =~ m/We have detected an open jumpgate from (.*?), located at (\d+):(\d+):(\d+). The fleet will approach our system in tick (\d+) and appears to have roughly (\d+) ships/g){ my $eta = $5 - $t; - my $mission = $4; - $mission = 'AllyDef' if $eta == 6 && $x != $1; - $f->execute($t,$eta,$1,$2,$3,$x,$y,$z,-1,$mission) or print $dbh->errstr; - $class = qq{ class="$mission"}; - }elsif($news eq 'Incoming' && $text =~ m/We have detected an open jumpgate from (?:[^<]*), located at (\d+):(\d+):(\d+). The fleet will approach our system in tick (\d+) and appears to have roughly (\d+) ships/g){ - my $eta = $4 - $t; my $mission = ''; + my $back = $5 + $eta; $mission = 'Defend' if $eta <= 6; - $mission = 'AllyDef' if $eta == 6 && $x != $1; - $f->execute($t,$eta,$x,$y,$z,$1,$2,$3,$5,$mission) or print $dbh->errstr; - $class = qq{ class="$mission"}; + $mission = 'AllyDef' if $eta == 6 && $x != $2; + my ($target) = $dbh->selectrow_array($findplanet,undef + ,$2,$3,$4,$t) or die $dbh->errstr; + die "No target: $2:$3:$4" unless defined $target; + my $id = addfleet($1,$mission,undef,$target,$planet,$5 + ,$eta,$back,$6, ($x == $2 && $y == $3)); + $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr; } - $text =~ s{(\d+):(\d+):(\d+)}{$1:$2:$3}g; - $scantext .= "$news\n"; } - $scantext .= "
(.+?)
$t$text
\n"; - } elsif($type eq 'Unit' || $type eq 'Advanced Unit' || $type eq 'Surface Analysis' || $type eq 'Technology Analysis'){ - $scantext .= "\n"; - my $i = 0; - my $total = 0; - my $sec = 0; - my $dist = 0; - my $f = $dbh->prepare(qq{SELECT "type","class" FROM ship_stats WHERE name = ?}); - my %visible; - my %total; + } elsif($type eq 'Surface Analysis' || $type eq 'Technology Analysis'){ + my $cat = ($type eq 'Surface Analysis' ? 'struc' : 'tech'); while($file =~ m{((?:[a-zA-Z]| )+)(\d+)}sg){ - $i++; - my $row = "odd"; - $row = "even" if ($i % 2 == 0); - $scantext .= "\n"; - $total += $2; - $sec = $2 if ($1 eq 'Security Centre'); - $dist = $2 if ($1 eq 'Wave Distorter'); - $f->execute($1); - if (my $ship = $f->fetchrow_hashref){ - $total{$ship->{class}} += $2; - $visible{$ship->{class}} += $2 unless $ship->{type} eq 'Cloak'; - } + $addpdata->execute($planet,$tick,$scan->{id} + ,$cat,$1, $2) or die $dbh->errstr; } - if ($type =~ 'Unit'){ - my $scan .= q{
$1$2
- }; - my $i = 0; - for my $type (qw/Fighter Corvette Frigate Destroyer Cruiser Battleship/){ - next unless $total{$type}; - $i++; - my $row = "odd"; - $row = "even" if ($i % 2 == 0); - $visible{$type} = 0 unless $visible{$type}; - $scan .= "\n"; - } - $scan .= "
ClassTotalVisible
$type".$total{$type}."".$visible{$type}."
\n"; - $addScan->execute($tick-1,$scan[0],'Ship Classes',$scan,$planet); - } - $scantext .= "NoShips\n" unless $i; - $scantext .= "\n"; - if($type eq 'Surface Analysis'){ - my $f = $dbh->prepare("UPDATE covop_targets SET structures = ?, sec_centres = ?, dists = ? WHERE planet = ?"); - if ($f->execute($total,$sec,$dist,$planet) < 1){ - $f = $dbh->prepare("INSERT INTO covop_targets (planet,structures, sec_centres, dists) VALUES(?,?,?,?)"); - $f->execute($planet,$total,$sec,$dist); - } + } elsif($type eq 'Unit' || $type eq 'Advanced Unit'){ + my $id = addfleet($type,'Full fleet',$file,$planet,undef,$tick,undef,undef,undef); + $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr; + } elsif($type eq 'Incoming'){ + while($file =~ m{class="left">Fleet: (.*?)Mission: (\w+)(.*?)Total Ships: (\d+)}sg){ + my $id = addfleet($1,$2,$3,$planet,undef,$tick,undef,undef,$4); + $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr; } - } elsif($type eq 'Military'){ - $scantext .= "\n"; - my $i = 1; - my @totals = (0,0,0,0); - my @eta = (8,8,8,8); - my $f = $dbh->prepare(qq{SELECT "type","class" FROM ship_stats WHERE name = ?}); - while($file =~ m/big left">((?:[a-zA-Z]| )+)<\/t[dh]>.*?center>(\d+).*?center>(\d+).*?center>(\d+).*?center>(\d+)/sg){ - next if ($2+$3+$4+$5 == 0); - my @ships = ($2,$3,$4,$5); - my $row = "odd"; - my ($type,$class) = $dbh->selectrow_array($f,undef,$1); - #print "$1 $type\n"; - $row = "even" if ($i % 2 == 0); - $scantext .= "\n"; - $i++; - unless ($type eq "Cloak"){ - $totals[0] += $2; - $totals[1] += $3; - $totals[2] += $4; - $totals[3] += $5; - } - foreach my $i (0,1,2,3){ - if ($ships[$i] > 0 && $eta[$i] < 9 && ($class =~ /Frigate|Destroyer/)){ - $eta[$i] = 9; - }elsif ($ships[$i] > 0 && $eta[$i] < 10 && ($class =~ /Cruiser|Battleship/)){ - $eta[$i] = 10; - } - } - } - $scantext .= "\n"; - $scantext .= "\n"; - $scantext .= "
$1$2$3$4$5
Total uncloaked$totals[0]$totals[1]$totals[2]$totals[3]
Initial eta$eta[0]$eta[1]$eta[2]$eta[3]
\n"; + } else { + print "Something wrong with scan $scan->{id} type $type at tick $tick http://game.planetarion.com/showscan.pl?scan_id=$scan->{scan_id}"; } - unless ($scantext || $type eq 'Incoming'){ - print "Something wrong with scan $scan[0] type $type at tick $tick"; + $parsedscan->execute($tick,$type,$planet,$scan->{id}) or die $dbh->errstr; + $dbh->pg_release('scans') or die "Couldn't save"; + $dbh->pg_savepoint('scans') or die "Couldn't save"; + #$dbh->rollback; + }; + if ($@) { + warn $@; + $dbh->pg_rollback_to('scans') or die "rollback didn't work"; } - $update->execute($tick,$type,$scantext,$planet,$scan[0],$scan[1]) or warn DBI->errstr; }else{ - my $f = $dbh->prepare('UPDATE users SET scan_points = scan_points - 1 WHERE uid = ? '); - $f->execute($scan[2]); - $delscan->execute($scan[0],$scan[1]); + warn "Nothing useful in scan: $scan->{id} http://game.planetarion.com/showscan.pl?scan_id=$scan->{scan_id}\n"; + $delscan->execute($scan->{id}); + $addpoints->execute(-1,$scan->{uid}) if $scan->{uid} > 0; } } -$dbh->disconnect; +#$dbh->rollback; +$dbh->commit; + +sub addfleet { + my ($name,$mission,$ships,$sender,$target,$tick,$eta,$back,$amount,$ingal) = @_; + + die "no sender" unless defined $sender; + + $ingal = 0 unless $ingal; + $back = $tick + 4 if $ingal && $eta <= 4; + + if ($mission eq 'Return'){ + ($sender,$target) = ($target,$sender); + $back = $tick + $eta if $eta; + } + + my @ships; + my $total = 0; + while(defined $ships && $ships =~ m{((?:[a-zA-Z]| )+)(\d+)}sg){ + $total += $2; + push @ships, [$1,$2]; + } + $amount = $total if (!defined $amount) && defined $ships; + my $id = $dbh->selectrow_array($addfleet,undef,$name,$mission,$sender + ,$target,$tick, $eta, $back, $amount,$ingal) or die $dbh->errstr; + for my $s (@ships){ + unshift @{$s},$id; + $addships->execute(@{$s}) or die $dbh->errstr; + } + return $id; +};