74 lines
2.1 KiB
Perl
74 lines
2.1 KiB
Perl
package LasTres::Location;
|
|
|
|
use v5.36.0;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use feature 'signatures';
|
|
|
|
use LasTres::Planets;
|
|
use Moo::Role;
|
|
|
|
requires qw/identifier name description parent actions npcs/;
|
|
|
|
my $planets = LasTres::Planets->new;
|
|
sub get($planet_id, $super_area_id, $area_id, $location_id) {
|
|
my $planet = $planets->hash->{$planet_id};
|
|
if (!defined $planet) {
|
|
die "No such planet $planet_id.";
|
|
}
|
|
my $super_area = $planet->super_areas->{$super_area_id};
|
|
if (!defined $super_area) {
|
|
die "No such super_area $super_area_id in planet $planet_id.";
|
|
}
|
|
my $area = $super_area->areas->{$area_id};
|
|
if (!defined $area) {
|
|
die "No such area $area_id in super_area $super_area_id in planet $planet_id.";
|
|
}
|
|
my $location = $area->locations->{$location_id};
|
|
if (!defined $location) {
|
|
die "No such location $location_id in area $area_id in super_area $super_area_id in planet $planet_id.";
|
|
|
|
}
|
|
return $location;
|
|
}
|
|
|
|
sub hash($self) {
|
|
my $location = $self;
|
|
if (!Moo::Role::does_role($location, 'LasTres::Location')) {
|
|
die "$location does not implement LasTres::Location.";
|
|
}
|
|
my $area = $location->parent;
|
|
if (!Moo::Role::does_role($area, 'LasTres::Area')) {
|
|
die "$area does not implement LasTres::Area.";
|
|
}
|
|
my $super_area = $area->parent;
|
|
if (!Moo::Role::does_role($super_area, 'LasTres::SuperArea')) {
|
|
die "$super_area does not implement LasTres::SuperArea.";
|
|
}
|
|
my $planet = $super_area->parent;
|
|
if (!Moo::Role::does_role($planet, 'LasTres::Planet')) {
|
|
die "$planet does not implement LasTres::Planet.";
|
|
}
|
|
return {
|
|
planet => {
|
|
name => $planet->name,
|
|
identifier => $planet->identifier,
|
|
},
|
|
super_area => {
|
|
name => $super_area->name,
|
|
identifier => $super_area->identifier,
|
|
},
|
|
area => {
|
|
name => $area->name,
|
|
identifier => $area->identifier,
|
|
},
|
|
location => {
|
|
name => $location->name,
|
|
identifier => $location->identifier,
|
|
},
|
|
}
|
|
}
|
|
1;
|