X-Git-Url: https://ruin.nu/git/?a=blobdiff_plain;f=scripts%2Fscans.pl;h=c1f08530cfb148733597f6db47a3730ed4f3210e;hb=2eff7489498cf9aab5a8ea7e6dae8334419ac3a6;hp=5b9e74eaf3a535ae718326416688aa18260f960c;hpb=e98253f3ad7a68c70dd5382f47ac7c3691fac022;p=ndwebbie.git diff --git a/scripts/scans.pl b/scripts/scans.pl index 5b9e74e..c1f0853 100755 --- a/scripts/scans.pl +++ b/scripts/scans.pl @@ -26,7 +26,10 @@ use CGI; use DBI; use DBD::Pg qw(:pg_types); use LWP::Simple; -use lib qw{/var/www/ndawn/lib/}; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + use ND::DB; our $dbh = ND::DB::DB(); @@ -73,13 +76,52 @@ 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 = ?), ?)}); +my $addplanetscan = $dbh->prepare(q{INSERT INTO planet_scans + (id,tick,planet,metal_roids,metal,crystal_roids,crystal,eonium_roids,eonium + ,agents,guards,light,medium,heavy,hidden) + VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)}); + +sub parse_planet { + my ($scan,$file) = @_; + + my @values = ($scan->{id},$scan->{tick},$scan->{planet}); + $file =~ s/(\d),(\d)/$1$2/g; + + while($file =~ m/"center">(Metal|Crystal|Eonium)\D+(\d+)\D+([\d,]+)/g){ + push @values,$2,$3; + } + if($file =~ m{Security\ Guards .+? "center">(\d+) + .+? "center">(\d+)}sx){ + push @values,$1,$2; + } + if($file =~ m{([A-Z][a-z]+)([A-Z][a-z]+)([A-Z][a-z]+)}){ + push @values,$1,$2,$3; + } + if($file =~ m{([\d,]+)}){ + push @values,$1; + } + $addplanetscan->execute(@values); +} + +my $adddevscan = $dbh->prepare(q{INSERT INTO development_scans + (id,tick,planet,light_fac,medium_fac,heavy_fac,amps,distorters + ,metal_ref,crystal_ref,eonium_ref,reslabs,fincents,seccents + ,travel,infra,hulls,waves,extraction,covert,mining,total) + VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + }); + + +my %parsers = ( + Planet => \&parse_planet, +); + $dbh->begin_work or die 'No transaction'; $newscans->execute or die $dbh->errstr; $dbh->pg_savepoint('scans') or die "No savepoint"; -my %production = (None => 0, Low => 35, Medium => 65, High => 100); +my $parsedscans = 0; + while (my $scan = $newscans->fetchrow_hashref){ $dbh->pg_release('scans') or die "Couldn't save"; $dbh->pg_savepoint('scans') or die "Couldn't save"; @@ -92,6 +134,7 @@ while (my $scan = $newscans->fetchrow_hashref){ my $y = $3; my $z = $4; my $tick = $5; + $scan->{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"; @@ -101,6 +144,7 @@ while (my $scan = $newscans->fetchrow_hashref){ next; } my ($planet) = $dbh->selectrow_array($findplanet,undef,$x,$y,$z,$tick); + $scan->{planet} = $planet; unless ($planet){ $dbh->pg_rollback_to('scans') or die "rollback didn't work"; if ( $x == 0 && $y == 0 && $z == 0 ){ @@ -113,31 +157,8 @@ while (my $scan = $newscans->fetchrow_hashref){ if ($file =~ /(Note: [^<]*)/){ #TODO: something about planet being closed? } - if ($type eq 'Planet'){ - $file =~ s/(\d),(\d)/$1$2/g; - 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{([A-Z][a-z]+)([A-Z][a-z]+)([A-Z][a-z]+)}){ - $addpdata->execute($planet,$tick,$scan->{id} - ,'planet','Light Usage', $production{$1}) or die $dbh->errstr; - $addpdata->execute($planet,$tick,$scan->{id} - ,'planet','Medium Usage', $production{$2}) or die $dbh->errstr; - $addpdata->execute($planet,$tick,$scan->{id} - ,'planet','Heavy Usage', $production{$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; - } + if (exists $parsers{$type}){ + $parsers{$type}->($scan,$file); }elsif ($type eq 'Jumpgate'){ #print "$file\n"; while ($file =~ m{(\d+):(\d+):(\d+)\D+(Attack|Defend|Return)([^<]*)\D+(\d+)\D+(\d+)}g){ @@ -180,13 +201,15 @@ while (my $scan = $newscans->fetchrow_hashref){ $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr; } } - } elsif($type eq 'Surface Analysis' || $type eq 'Technology Analysis'){ - my $cat = ($type eq 'Surface Analysis' ? 'struc' : 'tech'); + } elsif($type eq 'Development'){ + my @values = ($scan->{id},$tick,$planet); + my $total = 0; while($file =~ m{((?:[a-zA-Z]| )+)(\d+)}sg){ - $addpdata->execute($planet,$tick,$scan->{id} - ,$cat,$1, $2) or die $dbh->errstr; + push @values,$2; + $total += $2 if $#values <= 13; } - + push @values,$total; + $adddevscan->execute(@values); } 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; @@ -195,11 +218,13 @@ while (my $scan = $newscans->fetchrow_hashref){ my $id = addfleet($1,$2,$3,$planet,undef,$tick,undef,undef,$4); $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr; } + } elsif($type eq 'Landing'){ } else { - print "Something wrong with scan $scan->{id} type $type at tick $tick http://game.planetarion.com/showscan.pl?scan_id=$scan->{scan_id}"; + print "Something wrong with scan $scan->{id} type $type at tick $tick http://game.planetarion.com/showscan.pl?scan_id=$scan->{scan_id}\n"; } $parsedscan->execute($tick,$type,$planet,$scan->{id}) or die $dbh->errstr; #$dbh->rollback; + ++$parsedscans; }; if ($@) { warn $@; @@ -214,6 +239,8 @@ while (my $scan = $newscans->fetchrow_hashref){ #$dbh->rollback; $dbh->commit; +system 'killall','-USR1', 'irssi' if $parsedscans; + sub addfleet { my ($name,$mission,$ships,$sender,$target,$tick,$eta,$back,$amount,$ingal) = @_;