lib/NDWeb/Scans.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2006 by Michael Andreen <harvATruinDOTnu>               *
   3 #                                                                         *
   4 #   This program is free software; you can redistribute it and/or modify  *
   5 #   it under the terms of the GNU General Public License as published by  *
   6 #   the Free Software Foundation; either version 2 of the License, or     *
   7 #   (at your option) any later version.                                   *
   8 #                                                                         *
   9 #   This program is distributed in the hope that it will be useful,       *
  10 #   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
  11 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
  12 #   GNU General Public License for more details.                          *
  13 #                                                                         *
  14 #   You should have received a copy of the GNU General Public License     *
  15 #   along with this program; if not, write to the                         *
  16 #   Free Software Foundation, Inc.,                                       *
  17 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
  18 #**************************************************************************/
  19
  20 package NDWeb::Scans;
  21 use strict;
  22 use warnings;
  23 require Exporter;
  24
  25 our @ISA = qw/Exporter/;
  26
  27 our @EXPORT = qw/parseMilScan doMilScan doPlanetScan/;
  28
  29 my %classes = (Fighter => 'Fi', Corvette => 'Co', Frigate => 'Fr', Destroyer => 'De', Cruiser => 'Cr', Battleship => 'Bs', Structure => 'St', Roids => 'Ro', Resources => 'Re', '-' => '-');
  30
  31 sub parseMilScan ($) {
  32         my ($file) = @_;
  33         my @fleets;
  34
  35         while ($file =~ m{<th class="center">([^<]+)</th>}g) {
  36                 push @fleets, {name => $1, ships => []};
  37         }
  38
  39         while ($file =~ m{<tr><td class="left">([^<]+)</td>(.+?)</tr>}g) {
  40                 my $ship = $1;
  41                 next if $ship eq 'Total Ships';
  42                 my $amounts = $2;
  43                 my $i = 0;
  44                 while ($amounts =~ m{<td class="center">([\d,]+)</td>}g) {
  45                         my $fleet = $fleets[$i];
  46                         my $amount = $1;
  47                         $amount =~ s/,//g;
  48                         if ($ship eq 'Total Visible Ships') {
  49                                 $fleet->{amount} = $amount;
  50                         } elsif ($amount > 0) {
  51                                 push @{$fleet->{ships}}, {ship => $ship, amount => $amount};
  52                         }
  53                         ++$i;
  54                 }
  55         }
  56
  57         return @fleets;
  58 }
  59
  60 my $addfleet_sql = q{INSERT INTO fleets (name, mission, pid, tick, amount) VALUES(?,?,?,?,?) RETURNING fid};
  61 my $addships_sql = q{INSERT INTO fleet_ships (fid, ship, amount) VALUES(?,?,?)};
  62 my $fleetscan_sql = q{INSERT INTO fleet_scans (fid, id) VALUES(?,?)};
  63
  64 sub doMilScan ($$$) {
  65         my ($dbh, $scan,$file) = @_;
  66
  67         my $addfleet = $dbh->prepare_cached($addfleet_sql);
  68         my $fleetscan = $dbh->prepare_cached($fleetscan_sql);
  69         my $addships = $dbh->prepare_cached($addships_sql);
  70
  71         my @fleets = parseMilScan($file);
  72         for my $fleet (@fleets) {
  73                 next if $fleet->{amount} == 0;
  74                 $addfleet->execute($fleet->{name},$scan->{type},$scan->{pid}
  75                         ,$scan->{tick}, $fleet->{amount});
  76                 my ($id) = $addfleet->fetchrow_array;
  77                 $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr;
  78                 for my $s (@{$fleet->{ships}}){
  79                         $addships->execute($id, $s->{ship}, $s->{amount}) or die $dbh->errstr;
  80                 }
  81         }
  82 }
  83
  84 my $addplanetscan_sql = q{INSERT INTO planet_scans
  85         (id,tick,pid,metal_roids,metal,crystal_roids,crystal,eonium_roids,eonium
  86                 ,agents,guards,light,medium,heavy,hidden)
  87         VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)};
  88
  89 sub doPlanetScan ($$$) {
  90         my ($dbh, $scan,$file) = @_;
  91
  92         my $addplanetscan = $dbh->prepare_cached($addplanetscan_sql);
  93
  94         my @values = ($scan->{id},$scan->{tick},$scan->{pid});
  95         $file =~ s/(\d),(\d)/$1$2/g;
  96
  97         while($file =~ m{"center">(Metal|Crystal|Eonium)</td>\D+(\d+)\D+([\d,]+)}g){
  98                 push @values,$2,$3;
  99         }
 100         if($file =~ m{Security\ Guards .+? "center">(\d+)</td>
 101                         .+? "center">(\d+)</td>}sx){
 102                 push @values,$1,$2;
 103         }
 104         if($file =~ m{<td class="center">([A-Z][a-z]+)</td><td class="center">([A-Z][a-z]+)</td><td class="center">([A-Z][a-z]+)</td>}){
 105                 push @values,$1,$2,$3;
 106         }
 107         if($file =~ m{<span class="superhighlight">([\d,]+)</span>}){
 108                 push @values,$1;
 109         }
 110         $addplanetscan->execute(@values);
 111 }
 112