view release on metacpan or  search on metacpan

examples/star_db_util.pl  view on Meta::CPAN

                    }
                }
            }
        }

    }
}

$star_db->commit;

# SQLite can't vacuum in a transaction
    unless ($opts{'no-vacuum'}) {
    verbose("Vacuuming database\n");
    $star_db->{AutoCommit} = 1;
    $star_db->do('vacuum');
}

unless ($opts{'no-fetch'}) {
    output("$db_file is now up-to-date with your probe data\n");
}

output("$glc->{total_calls} api calls made.\n") if $glc->{total_calls};
undef $glc;
exit 0;

sub ore_types {
    return qw{
            anthracite bauxite beryl chalcopyrite chromite fluorite galena goethite gold gypsum
            halite kerogen magnetite methane monazite rutile sulfur trona uraninite zircon
    };
}

{
    my $check_star;
    sub star_exists {
        my ($x, $y) = @_;
        $check_star ||= $star_db->prepare(q{select *, strftime('%s',last_checked) checked_epoch from stars where x = ? and y = ?});
        $check_star->execute($x, $y);
        my $row = $check_star->fetchrow_hashref;
        return $row;
    }
}

{
    my $insert_star;
    sub insert_star {
        my ($star) = @_;
        my ($id, $name, $x, $y, $color, $zone) = @{$star}{qw/id name x y color zone/};

        my $when = $star->{last_checked} || strftime "%Y-%m-%d %T", gmtime;

        output("Inserting star $name at $x, $y\n");
        $insert_star ||= $star_db->prepare('insert into stars (id, name, x, y, color, zone, last_checked) values (?,?,?,?,?,?,?)');
        $insert_star->execute($id, $name, $x, $y, $color, $zone, $when)
            or die "Can't insert star: " . $insert_star->errstr;
    }
}

{
    my $update_star;
    sub update_star {
        my ($star) = @_;
        my ($x, $y, $name, $color, $zone) = @{$star}{qw/x y name color zone/};

        my $when = $star->{last_checked} || strftime "%Y-%m-%d %T", gmtime;

        output("Updating star at $x, $y to name $name, color $color, zone $zone\n");
        $update_star ||= $star_db->prepare(q{update stars set last_checked = ?, name = ?, color = ?, zone = ? where x = ? and y = ?});
        $update_star->execute($when, $name, $color, $zone, $x, $y);
    }
}

{
    my $star_checked;
    sub mark_star_checked {
        my ($x, $y) = @_;
        $star_checked ||= $star_db->prepare(q{update stars set last_checked = datetime('now') where x = ? and y = ?});
        $star_checked->execute($x, $y)
            or die "Can't mark star checked: " . $star_checked->errstr;
    }
}

{
    my $check_orbital;
    sub orbital_exists {
        my ($x, $y) = @_;

        $check_orbital ||= $star_db->prepare(q{select *, strftime('%s',last_checked) checked_epoch from orbitals where x = ? and y = ?});
        $check_orbital->execute($x, $y);
        return $check_orbital->fetchrow_hashref;
    }
}

{
    my $insert_orbital;
    sub insert_orbital {
        my ($body) = @_;
        my @body_fields = qw{ body_id star_id orbit x y type name water size };
        output(sprintf  "Inserting %s at %d, %d\n", $body->{'type'}, $body->{'x'}, $body->{'y'});

        my $when = $body->{last_checked} || strftime "%Y-%m-%d %T", gmtime;

        my $insert_statement =
            q{insert into orbitals (last_checked, }
            . join(", ",
                @body_fields, ore_types(),
                'empire_id', 'subtype'
            )
            . ') values (?,'
            . join(',', map { "?" } @body_fields, ore_types(), 'empire_id', 'subtype')
            . ')';

        my $subtype;
        if (defined $body->{'image'}) {
            ($subtype = $body->{'image'}) =~ s/-.*//;
        }
        my @insert_vars = (
            $when,
            ( map { $body->{$_} } @body_fields ),
            ( map { $body->{'ore'}->{$_} } ore_types() ),
            $body->{'empire'}->{'id'},
            $subtype,
        );

        $insert_orbital ||= $star_db->prepare($insert_statement);
        $insert_orbital->execute(@insert_vars)
            or die( "Can't insert orbital: " . $insert_orbital->errstr);

        update_empire($body->{empire}) if $body->{empire} and $body->{empire}{name};
    }
}

{
    my $update_orbital;
    sub update_orbital {
        my ($body) = @_;

        my @body_fields = qw{ type name x y water size };
        output(sprintf  "Updating %s at %d, %d\n", $body->{'type'}, $body->{'x'}, $body->{'y'});

        my $when = $body->{last_checked} || strftime "%Y-%m-%d %T", gmtime;

        my $update_statement =
            join(", ",
                q{update orbitals set last_checked = ? },
                ( map { "$_ = ?" } @body_fields, ore_types() ),
                'empire_id = ?, subtype = ?'
            )
            . ' where x = ? and y = ?';

        my @update_vars = (
            $when,
            ( map { $body->{$_} } @body_fields ),
            ( map { $body->{'ore'}->{$_} } ore_types() ),
        );
        my $subtype;
        if (defined $body->{'image'}) {
            ($subtype = $body->{'image'}) =~ s/-.*//;
        }
        push( @update_vars, $body->{'empire'}->{'id'}, $subtype, $body->{'x'}, $body->{'y'} );
        $update_orbital ||= $star_db->prepare($update_statement);

        $update_orbital->execute(@update_vars)
            or die("Can't update orbital: " . $update_orbital->errstr);

        update_empire($body->{empire}) if $body->{empire} and $body->{empire}{name};
    }
}

sub update_empire {
    my $empire = shift;

    return unless defined $empire->{id};

    my $exists = $star_db->selectrow_hashref('select * from empires where id = ?', {}, $empire->{id});
    unless ($exists) {
        output("Inserting empire $empire->{name} ($empire->{id})\n");
        $star_db->do('insert into empires (id, name) values (?,?)', {}, $empire->{id}, $empire->{name});
    }
}

{
    my $orbital_checked;
    sub mark_orbital_checked {
        my ($x, $y) = @_;
        $orbital_checked ||= $star_db->prepare(q{update orbitals set last_checked = datetime('now') where x = ? and y = ?});
        $orbital_checked->execute($x, $y)
            or die "Can't mark orbital checked: " . $orbital_checked->errstr;
    }
}


sub normalize_planet {
    my ($planet_name) = @_;

    $planet_name =~ s/\W//g;
    $planet_name = lc($planet_name);
    return $planet_name;
}

sub find_observatory {
    my ($buildings) = @_;

    # Find an Observatory
    my $obs_id = first {
            $buildings->{$_}->{name} eq 'Observatory'
    } keys %$buildings;

    return if not $obs_id;
    return $glc->building(id => $obs_id, type => 'Observatory');
}


sub create_star_db_sql {
    return
        <<SQL,
CREATE TABLE stars (
    id           int   primary key,
    name         text,
    x            int,
    y            int,
    color        text,
    zone         text,
    last_checked datetime
)
SQL
        <<SQL,
CREATE TABLE orbitals (
    body_id        int,
    star_id        int,