view release on metacpan or  search on metacpan

examples/map/lib/LacunaMap/DB.pm  view on Meta::CPAN

          id INT UNIQUE,
          name TEXT,
          x INT,
          y INT,
          star_id INT NOT NULL,
          orbit INT,
          type TEXT,
          size INT,
          water INT,
          empire_id INT
        );
HERE
      $dbh->do(<<'HERE');
        CREATE TABLE news (
          id INTEGER PRIMARY KEY AUTOINCREMENT,
          zone TEXT,
          title TEXT,
          time TIMESTAMP
        );
HERE
    # todo ore-body table
    },
    tables       => [ qw(stars bodies news) ],
    #cleanup      => 'VACUUM',
    @_
  });
}

package LacunaMap::DB::Stars;
sub min_x {
  my $row = LacunaMap::DB->selectrow_arrayref("SELECT MIN(x) FROM stars");
  ref($row) && ref($row) eq 'ARRAY' && @$row > 0 && defined($row->[0])
    or die "Is the stars database empty? Did you load a database?";
  return $row->[0];
}

sub max_x {
  my $row = LacunaMap::DB->selectrow_arrayref("SELECT MAX(x) FROM stars");
  ref($row) && ref($row) eq 'ARRAY' && @$row > 0 && defined($row->[0])
    or die "Is the stars database empty? Did you load a database?";
  return $row->[0];
}

sub min_y {
  my $row = LacunaMap::DB->selectrow_arrayref("SELECT MIN(y) FROM stars");
  ref($row) && ref($row) eq 'ARRAY' && @$row > 0 && defined($row->[0])
    or die "Is the stars database empty? Did you load a database?";
  return $row->[0];
}

sub max_y {
  my $row = LacunaMap::DB->selectrow_arrayref("SELECT MAX(y) FROM stars");
  ref($row) && ref($row) eq 'ARRAY' && @$row > 0 && defined($row->[0])
    or die "Is the stars database empty? Did you load a database?";
  return $row->[0];
}


package LacunaMap::DB::Bodies;

sub update_from_news {
  my $class = shift;
  my $client = shift;
  my $news = shift;

  my $updater = sub {
    my $news = $_;
    my $res = $news->parse_title;
    return if not $res;
    if ($res->{type} eq 'new colony') {
      warn "NEW COLONY";
        use Data::Dumper;
        warn Dumper $res;

      my $stars = LacunaMap::DB::Stars->select(
        'where name = ?', $res->{star_name}
      );
      if (@$stars > 1) {
        warn "Found multiple stars for the given new colony";
        return;
      }
      elsif (@$stars == 0) {
        warn "Found no star for the given new colony";
        return;
      }
      my $sid = $stars->[0]->id;

      my $eid = _find_empire_id($client, $res->{empire_name});
      return if not defined $eid;

      my $bodies = LacunaMap::DB::Bodies->select(
        'where star_id = ? and name = ?', $sid, $res->{body_name}
      );
      if (not @$bodies) {
        # new entry
        LacunaMap::DB::Bodies->new(
          name      => $res->{body_name},
          empire_id => $eid,
          star_id   => $sid,
        )->insert;
      }
      elsif (@$bodies == 1) {
        for ($bodies->[0]) {
          $_->delete();
          $_->name($res->{body_name});
          $_->empire_id($res->{empire_id});
          $_->star_id($res->{star_id});
          $_->insert();
        }
      }
      else {
        warn "Found multiple bodies for the given new colony";
        return;
      }
    } # end if new colony
    elsif ($res->{type} eq 'rename') {
      my $bodies = LacunaMap::DB::Bodies->select('where name = ?', $res->{old_body_name});
      if ($bodies and @$bodies == 1) { # only rename if unique
        my $b = $bodies->[0];
        $b->delete;
        $b->name($res->{new_body_name});