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, mission => 'Military', ships => []};
  37         }
  38         push @fleets, {name => 'Military', mission => 'Full fleet', ships => []};
  39
  40         my $total = 0;
  41         while ($file =~ m{<tr><td class="left">([^<]+)</td>(.+?)</tr>}g) {
  42                 my $ship = $1;
  43                 next if $ship eq 'Total Visible Ships';
  44                 my $amounts = $2;
  45                 my $tot_amount = 0;
  46                 my $i = 0;
  47                 while ($amounts =~ m{<td class="center">([\d,]+)</td>}g) {
  48                         my $fleet = $fleets[$i];
  49                         my $amount = $1;
  50                         $amount =~ s/,//g;
  51                         if ($ship eq 'Total Ships') {
  52                                 $fleet->{amount} = $amount;
  53                         } elsif ($amount > 0) {
  54                                 $tot_amount += $amount;
  55                                 $total += $amount;
  56                                 push @{$fleet->{ships}}, {ship => $ship, amount => $amount};
  57                         }
  58                         ++$i;
  59                 }
  60
  61                 if ($tot_amount > 0) {
  62                         push @{$fleets[4]->{ships}}, {ship => $ship, amount => $tot_amount};
  63                 }
  64         }
  65         $fleets[4]->{amount} = $total;
  66
  67         return @fleets;
  68 }
  69
  70 my $addfleet_sql = q{INSERT INTO fleets (name, mission, pid, tick, amount) VALUES(?,?,?,?,?) RETURNING fid};
  71 my $addships_sql = q{INSERT INTO fleet_ships (fid, ship, amount) VALUES(?,?,?)};
  72 my $fleetscan_sql = q{INSERT INTO fleet_scans (fid, id) VALUES(?,?)};
  73
  74 sub doMilScan ($$$) {
  75         my ($dbh, $scan,$file) = @_;
  76
  77         my $addfleet = $dbh->prepare_cached($addfleet_sql);
  78         my $fleetscan = $dbh->prepare_cached($fleetscan_sql);
  79         my $addships = $dbh->prepare_cached($addships_sql);
  80
  81         my @fleets = parseMilScan($file);
  82         for my $fleet (@fleets) {
  83                 next if $fleet->{amount} == 0 && $fleet->{mission} eq 'Military';
  84                 $addfleet->execute($fleet->{name},$fleet->{mission},$scan->{pid}
  85                         ,$scan->{tick}, $fleet->{amount});
  86                 my ($id) = $addfleet->fetchrow_array;
  87                 $fleetscan->execute($id,$scan->{id}) or die $dbh->errstr;
  88                 for my $s (@{$fleet->{ships}}){
  89                         $addships->execute($id, $s->{ship}, $s->{amount}) or die $dbh->errstr;
  90                 }
  91         }
  92 }
  93
  94 my $addplanetscan_sql = q{INSERT INTO planet_scans
  95         (id,tick,pid,metal_roids,metal,crystal_roids,crystal,eonium_roids,eonium
  96                 ,agents,guards,light,medium,heavy,hidden)
  97         VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)};
  98
  99 sub doPlanetScan ($$$) {
 100         my ($dbh, $scan,$file) = @_;
 101
 102         my $addplanetscan = $dbh->prepare_cached($addplanetscan_sql);
 103
 104         my @values = ($scan->{id},$scan->{tick},$scan->{pid});
 105         $file =~ s/(\d),(\d)/$1$2/g;
 106
 107         while($file =~ m{"center">(Metal|Crystal|Eonium)</td>\D+(\d+)\D+([\d,]+)}g){
 108                 push @values,$2,$3;
 109         }
 110         if($file =~ m{Security\ Guards .+? "center">(\d+)</td>
 111                         .+? "center">(\d+)</td>}sx){
 112                 push @values,$1,$2;
 113         }
 114         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>}){
 115                 push @values,$1,$2,$3;
 116         }
 117         if($file =~ m{<span class="superhighlight">([\d,]+)</span>}){
 118                 push @values,$1;
 119         }
 120         $addplanetscan->execute(@values);
 121 }
 122