Creating tests to check that map is correctly generated and solving some discovered errors.

Build.PL

@@ -26,6 +26,7 @@ my $build = Module::Build->new(
         'List::AllUtils'                    => 0,
         'DateTime::Format::Pg'              => 0,
         'DateTime::Format::ISO8601::Format' => 0,
+        'Test::Most'                        => 0,
     },
 );
 $build->create_build_script;

dbicdh/PostgreSQL/deploy/13/001-auto.sql

@@ -0,0 +1,334 @@
+--
+-- Created by SQL::Translator::Producer::PostgreSQL
+-- Created on Sun Jul  9 16:13:46 2023
+--
+;
+--
+-- Table: equipment
+--
+CREATE TABLE "equipment" (
+  "uuid" uuid NOT NULL,
+  PRIMARY KEY ("uuid")
+);
+
+;
+--
+-- Table: inventories
+--
+CREATE TABLE "inventories" (
+  "uuid" uuid NOT NULL,
+  PRIMARY KEY ("uuid")
+);
+
+;
+--
+-- Table: players
+--
+CREATE TABLE "players" (
+  "uuid" uuid NOT NULL,
+  "username" text NOT NULL,
+  "encrypted_password" text NOT NULL,
+  "email" text NOT NULL,
+  "verified" boolean NOT NULL,
+  "verification_token" text,
+  "register_date" timestamp DEFAULT NOW() NOT NULL,
+  "last_activity" timestamp DEFAULT NOW() NOT NULL,
+  PRIMARY KEY ("uuid"),
+  CONSTRAINT "unique_constraint_email" UNIQUE ("email"),
+  CONSTRAINT "unique_constraint_username" UNIQUE ("username")
+);
+
+;
+--
+-- Table: skill_like_lists
+--
+CREATE TABLE "skill_like_lists" (
+  "uuid" uuid DEFAULT uuid_generate_v4() NOT NULL,
+  PRIMARY KEY ("uuid")
+);
+
+;
+--
+-- Table: stats
+--
+CREATE TABLE "stats" (
+  "uuid" uuid NOT NULL,
+  "health" integer NOT NULL,
+  "mana" integer NOT NULL,
+  "strength" integer NOT NULL,
+  "resistance" integer NOT NULL,
+  "magic" integer NOT NULL,
+  "speed" integer NOT NULL,
+  "intelligence" integer NOT NULL,
+  PRIMARY KEY ("uuid")
+);
+
+;
+--
+-- Table: equipment_items
+--
+CREATE TABLE "equipment_items" (
+  "kind" text NOT NULL,
+  "equipment" uuid NOT NULL,
+  "identifier" text NOT NULL,
+  "quantity" integer NOT NULL,
+  PRIMARY KEY ("kind", "equipment")
+);
+CREATE INDEX "equipment_items_idx_equipment" on "equipment_items" ("equipment");
+
+;
+--
+-- Table: inventory_items
+--
+CREATE TABLE "inventory_items" (
+  "uuid" uuid DEFAULT uuid_generate_v4() NOT NULL,
+  "inventory" uuid NOT NULL,
+  "identifier" text NOT NULL,
+  "quantity" integer NOT NULL,
+  PRIMARY KEY ("uuid"),
+  CONSTRAINT "inventory_items_unique_item" UNIQUE ("inventory", "identifier")
+);
+CREATE INDEX "inventory_items_idx_inventory" on "inventory_items" ("inventory");
+
+;
+--
+-- Table: skill_like_items
+--
+CREATE TABLE "skill_like_items" (
+  "identifier" text NOT NULL,
+  "owner_list" uuid NOT NULL,
+  "level" integer DEFAULT 1 NOT NULL,
+  PRIMARY KEY ("identifier", "owner_list")
+);
+CREATE INDEX "skill_like_items_idx_owner_list" on "skill_like_items" ("owner_list");
+
+;
+--
+-- Table: teams
+--
+CREATE TABLE "teams" (
+  "uuid" uuid NOT NULL,
+  "is_exploring" boolean DEFAULT false NOT NULL,
+  "action_frame" integer DEFAULT 0 NOT NULL,
+  "is_moving" boolean DEFAULT false NOT NULL,
+  "last_spawn" jsonb DEFAULT 'null' NOT NULL,
+  "moving_to" jsonb DEFAULT 'null' NOT NULL,
+  "leader" uuid,
+  "name" text NOT NULL,
+  "planet" text NOT NULL,
+  "super_area" text NOT NULL,
+  "area" text NOT NULL,
+  "location" text NOT NULL,
+  "current_battle" uuid,
+  PRIMARY KEY ("uuid")
+);
+CREATE INDEX "teams_idx_leader" on "teams" ("leader");
+
+;
+--
+-- Table: player_pjs
+--
+CREATE TABLE "player_pjs" (
+  "uuid" uuid NOT NULL,
+  "owner" uuid NOT NULL,
+  "full_name" text NOT NULL,
+  "short_name" text NOT NULL,
+  "nick" text NOT NULL,
+  "race" text NOT NULL,
+  "team" uuid NOT NULL,
+  "creation_date" timestamp DEFAULT NOW() NOT NULL,
+  "last_activity" timestamp DEFAULT NOW() NOT NULL,
+  "experience" integer DEFAULT 1 NOT NULL,
+  "equipment" uuid NOT NULL,
+  "born_stats" uuid NOT NULL,
+  "training_stats" uuid NOT NULL,
+  "skills" uuid NOT NULL,
+  "spells" uuid NOT NULL,
+  "inventory" uuid NOT NULL,
+  "health" integer NOT NULL,
+  "mana" integer NOT NULL,
+  "combat_target" uuid,
+  "combat_action" text,
+  PRIMARY KEY ("uuid")
+);
+CREATE INDEX "player_pjs_idx_born_stats" on "player_pjs" ("born_stats");
+CREATE INDEX "player_pjs_idx_equipment" on "player_pjs" ("equipment");
+CREATE INDEX "player_pjs_idx_inventory" on "player_pjs" ("inventory");
+CREATE INDEX "player_pjs_idx_owner" on "player_pjs" ("owner");
+CREATE INDEX "player_pjs_idx_skills" on "player_pjs" ("skills");
+CREATE INDEX "player_pjs_idx_spells" on "player_pjs" ("spells");
+CREATE INDEX "player_pjs_idx_team" on "player_pjs" ("team");
+CREATE INDEX "player_pjs_idx_training_stats" on "player_pjs" ("training_stats");
+
+;
+--
+-- Table: player_companion_npcs
+--
+CREATE TABLE "player_companion_npcs" (
+  "uuid" uuid DEFAULT uuid_generate_v4() NOT NULL,
+  "owner" uuid NOT NULL,
+  "identifier" text NOT NULL,
+  "nick" text,
+  "race" text NOT NULL,
+  "level" integer DEFAULT 1 NOT NULL,
+  "exp" integer DEFAULT 1 NOT NULL,
+  "equipment" uuid NOT NULL,
+  "stats" uuid NOT NULL,
+  "skills" uuid NOT NULL,
+  "spells" uuid NOT NULL,
+  "inventory" uuid NOT NULL,
+  PRIMARY KEY ("uuid")
+);
+CREATE INDEX "player_companion_npcs_idx_equipment" on "player_companion_npcs" ("equipment");
+CREATE INDEX "player_companion_npcs_idx_inventory" on "player_companion_npcs" ("inventory");
+CREATE INDEX "player_companion_npcs_idx_owner" on "player_companion_npcs" ("owner");
+CREATE INDEX "player_companion_npcs_idx_skills" on "player_companion_npcs" ("skills");
+CREATE INDEX "player_companion_npcs_idx_spells" on "player_companion_npcs" ("spells");
+CREATE INDEX "player_companion_npcs_idx_stats" on "player_companion_npcs" ("stats");
+
+;
+--
+-- Table: player_pjs_flags
+--
+CREATE TABLE "player_pjs_flags" (
+  "name" text NOT NULL,
+  "owner" uuid NOT NULL,
+  PRIMARY KEY ("name", "owner")
+);
+CREATE INDEX "player_pjs_flags_idx_owner" on "player_pjs_flags" ("owner");
+CREATE INDEX "index_flag" on "player_pjs_flags" ("owner", "name");
+
+;
+--
+-- Table: player_pjs_known_places
+--
+CREATE TABLE "player_pjs_known_places" (
+  "owner" uuid NOT NULL,
+  "planet" text NOT NULL,
+  "super_area" text NOT NULL,
+  "area" text NOT NULL,
+  "location" text NOT NULL,
+  PRIMARY KEY ("owner", "planet", "super_area", "area", "location")
+);
+CREATE INDEX "player_pjs_known_places_idx_owner" on "player_pjs_known_places" ("owner");
+
+;
+--
+-- Table: player_pjs_known_words
+--
+CREATE TABLE "player_pjs_known_words" (
+  "identifier" text NOT NULL,
+  "owner" uuid NOT NULL,
+  PRIMARY KEY ("identifier", "owner")
+);
+CREATE INDEX "player_pjs_known_words_idx_owner" on "player_pjs_known_words" ("owner");
+CREATE INDEX "index_known_word" on "player_pjs_known_words" ("owner", "identifier");
+
+;
+--
+-- Table: player_pjs_log
+--
+CREATE TABLE "player_pjs_log" (
+  "uuid" uuid NOT NULL,
+  "content" jsonb NOT NULL,
+  "owner" uuid NOT NULL,
+  "date" timestamp DEFAULT NOW() NOT NULL,
+  PRIMARY KEY ("uuid")
+);
+CREATE INDEX "player_pjs_log_idx_owner" on "player_pjs_log" ("owner");
+CREATE INDEX "index_log" on "player_pjs_log" ("owner", "date");
+
+;
+--
+-- Foreign Key Definitions
+--
+
+;
+ALTER TABLE "equipment_items" ADD CONSTRAINT "equipment_items_fk_equipment" FOREIGN KEY ("equipment")
+  REFERENCES "equipment" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "inventory_items" ADD CONSTRAINT "inventory_items_fk_inventory" FOREIGN KEY ("inventory")
+  REFERENCES "inventories" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "skill_like_items" ADD CONSTRAINT "skill_like_items_fk_owner_list" FOREIGN KEY ("owner_list")
+  REFERENCES "skill_like_lists" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "teams" ADD CONSTRAINT "teams_fk_leader" FOREIGN KEY ("leader")
+  REFERENCES "player_pjs" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs" ADD CONSTRAINT "player_pjs_fk_born_stats" FOREIGN KEY ("born_stats")
+  REFERENCES "stats" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs" ADD CONSTRAINT "player_pjs_fk_equipment" FOREIGN KEY ("equipment")
+  REFERENCES "equipment" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs" ADD CONSTRAINT "player_pjs_fk_inventory" FOREIGN KEY ("inventory")
+  REFERENCES "inventories" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs" ADD CONSTRAINT "player_pjs_fk_owner" FOREIGN KEY ("owner")
+  REFERENCES "players" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs" ADD CONSTRAINT "player_pjs_fk_skills" FOREIGN KEY ("skills")
+  REFERENCES "skill_like_lists" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs" ADD CONSTRAINT "player_pjs_fk_spells" FOREIGN KEY ("spells")
+  REFERENCES "skill_like_lists" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs" ADD CONSTRAINT "player_pjs_fk_team" FOREIGN KEY ("team")
+  REFERENCES "teams" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs" ADD CONSTRAINT "player_pjs_fk_training_stats" FOREIGN KEY ("training_stats")
+  REFERENCES "stats" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_companion_npcs" ADD CONSTRAINT "player_companion_npcs_fk_equipment" FOREIGN KEY ("equipment")
+  REFERENCES "equipment" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_companion_npcs" ADD CONSTRAINT "player_companion_npcs_fk_inventory" FOREIGN KEY ("inventory")
+  REFERENCES "inventories" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_companion_npcs" ADD CONSTRAINT "player_companion_npcs_fk_owner" FOREIGN KEY ("owner")
+  REFERENCES "player_pjs" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "player_companion_npcs" ADD CONSTRAINT "player_companion_npcs_fk_skills" FOREIGN KEY ("skills")
+  REFERENCES "skill_like_lists" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_companion_npcs" ADD CONSTRAINT "player_companion_npcs_fk_spells" FOREIGN KEY ("spells")
+  REFERENCES "skill_like_lists" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_companion_npcs" ADD CONSTRAINT "player_companion_npcs_fk_stats" FOREIGN KEY ("stats")
+  REFERENCES "stats" ("uuid") DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs_flags" ADD CONSTRAINT "player_pjs_flags_fk_owner" FOREIGN KEY ("owner")
+  REFERENCES "player_pjs" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs_known_places" ADD CONSTRAINT "player_pjs_known_places_fk_owner" FOREIGN KEY ("owner")
+  REFERENCES "player_pjs" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs_known_words" ADD CONSTRAINT "player_pjs_known_words_fk_owner" FOREIGN KEY ("owner")
+  REFERENCES "player_pjs" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE "player_pjs_log" ADD CONSTRAINT "player_pjs_log_fk_owner" FOREIGN KEY ("owner")
+  REFERENCES "player_pjs" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;

dbicdh/PostgreSQL/upgrade/12-13/001-auto.sql

@@ -0,0 +1,25 @@
+-- Convert schema '/var/lib/las_tres/LasTres/script/../dbicdh/_source/deploy/12/001-auto.yml' to '/var/lib/las_tres/LasTres/script/../dbicdh/_source/deploy/13/001-auto.yml':;
+
+;
+BEGIN;
+
+;
+CREATE TABLE "player_pjs_known_words" (
+  "identifier" text NOT NULL,
+  "owner" uuid NOT NULL,
+  PRIMARY KEY ("identifier", "owner")
+);
+CREATE INDEX "player_pjs_known_words_idx_owner" on "player_pjs_known_words" ("owner");
+CREATE INDEX "index_known_word" on "player_pjs_known_words" ("owner", "identifier");
+
+;
+ALTER TABLE "player_pjs_known_words" ADD CONSTRAINT "player_pjs_known_words_fk_owner" FOREIGN KEY ("owner")
+  REFERENCES "player_pjs" ("uuid") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE;
+
+;
+ALTER TABLE teams DROP CONSTRAINT u_name;
+
+;
+
+COMMIT;
+

lib/LasTres/Planet/Bahdder.pm

@@ -13,7 +13,8 @@ use Module::Pluggable search_path => ['LasTres::Planet::Bahdder'],
     instantiate => 'instance',
     on_require_error => sub ($plugin, $error) {
         die $error;
-    };
+    },
+    max_depth => 4;
 
 with 'LasTres::Planet';
 

lib/LasTres/Planet/Bahdder/BosqueDelHeroe.pm

@@ -15,7 +15,8 @@ use Module::Pluggable search_path => ['LasTres::Planet::Bahdder::BosqueDelHeroe'
     instantiate => 'instance',
     on_require_error => sub ($plugin, $error) {
         die $error;
-    };
+    },
+    max_depth => 5;
 
 use LasTres::Planet::Bahdder;
 

lib/LasTres/Planet/Bahdder/BosqueDelHeroe/BosqueDelHeroeI.pm

@@ -13,7 +13,8 @@ use Module::Pluggable search_path => ['LasTres::Planet::Bahdder::BosqueDelHeroe:
     instantiate => 'instance',
     on_require_error => sub ($plugin, $error) {
         die $error;
-    };
+    },
+    max_depth => 6;
 
 use Moo;
 

lib/LasTres/Planet/Bahdder/BosqueDelHeroe/TribuDeLaLima.pm

@@ -14,7 +14,8 @@ use Module::Pluggable
   instantiate => 'instance',
   on_require_error => sub ( $plugin, $error ) {
     die $error;
-  };
+  },
+  max_depth => 6;
 
 use Moo;
 use LasTres::Planet::Bahdder::BosqueDelHeroe;

lib/LasTres/Planets.pm

@@ -13,7 +13,8 @@ use Module::Pluggable search_path => ['LasTres::Planet'],
     instantiate => 'instance',
     on_require_error => sub ($plugin, $error) {
         die $error;
-    };
+    },
+    max_depth => 3;
 
 has hash => (
     is => 'rw',
@@ -24,7 +25,15 @@ has hash => (
 sub _build_hash($self) {
     my @planets = $self->plugins();
     my %hash;
+    say @planets;
     for my $planet (@planets) {
+        my $identifier = $planet->identifier;
+        if (exists $hash{$planet->identifier}) {
+            die "Planet @{[$planet->identifier]} is repeated";
+        }
+        if (!$planet->does('LasTres::Planet')) {
+            die "$identifier does not implement LasTres::Planet.";
+        }
         $hash{$planet->identifier} = $planet;
     }
     return \%hash;

t/00-map-check.t

@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+
+use v5.36.0;
+use strict;
+use warnings;
+
+use feature 'signatures';
+
+use Scalar::Util qw/blessed/;
+
+use Test::Most qw/no_plan bail/;
+
+{
+    require LasTres::Planets;
+    my $planets = LasTres::Planets->new;
+    my $planets_hash = $planets->hash;
+    for my $planet_identifier (keys %$planets_hash) {
+        my $planet = $planets_hash->{$planet_identifier};
+        test_planet($planet);
+    }
+}
+
+sub test_planet($planet) {
+    my $super_areas_hash = $planet->super_areas;
+    is ref($super_areas_hash), 'HASH', (blessed $planet) 
+        . ' super_areas method returns a hashref.';
+    
+    for my $super_area_identifier (keys %$super_areas_hash) {
+        my $super_area = $super_areas_hash->{$super_area_identifier};
+        test_super_area($super_area);
+    }
+}
+
+sub test_super_area($super_area) {
+    ok $super_area->does('LasTres::SuperArea'),
+        (blessed $super_area) . ' implements LasTres::SuperArea.';
+    my $areas_hash = $super_area->areas;
+    is ref($areas_hash), 'HASH', (blessed $super_area)
+        . ' areas method returns a hashref.';
+
+    for my $area_identifier (keys %$areas_hash) {
+        my $area = $areas_hash->{$area_identifier};
+        test_area($area);
+    }
+}
+
+sub test_area($area) {
+    ok $area->does('LasTres::Area'),
+        (blessed $area) . ' implements LasTres::Area.';
+    my $locations_hash = $area->locations;
+    is ref($locations_hash), 'HASH', (blessed $area)
+        . ' locations method returns a hashref.';
+
+    for my $location_identifier (keys %$locations_hash) {
+        my $location = $locations_hash->{$location_identifier};
+        test_location($location);
+    }
+}
+
+sub test_location($location) {
+    ok $location->does('LasTres::Location'),
+        (blessed $location) . ' implements LasTres::Location.';
+}