view release on metacpan or  search on metacpan

lib/Games/Lacuna/Client/Buildings.pm  view on Meta::CPAN

    SpacePort
    SSLA
    StationCommand
    SubspaceSupplyDepot
    TempleOfTheDrajilites
    TheDillonForge
    TheftTraining
    ThemePark
    Trade
    Transporter
    Warehouse
    WasteExchanger
    WasteRecycling
    WaterStorage
  ),
);
for my $building_type ( @BuildingTypes ){
    eval "require Games::Lacuna::Client::Buildings::$building_type;";
    die "Unable to load building type module $building_type: $@" if $@;
}

use Class::XSAccessor {
  getters => [qw(building_id)],
};

sub api_methods {
  return {
    build               => { default_args => [qw(session_id)] },
    view                => { default_args => [qw(session_id building_id)] },
    upgrade             => { default_args => [qw(session_id building_id)] },
    demolish            => { default_args => [qw(session_id building_id)] },
    downgrade           => { default_args => [qw(session_id building_id)] },
    get_stats_for_level => { default_args => [qw(session_id building_id)] },
    repair              => { default_args => [qw(session_id building_id)] },
  };
}

sub new {
  my $class = shift;
  $class = ref($class)||$class; # no cloning
  my %opt = @_;
  my $btype = delete $opt{type};

  # redispatch in factory mode
  if (defined $btype) {
    if ($class ne 'Games::Lacuna::Client::Buildings') {
      croak("Cannot call ->new on Games::Lacuna::Client::Buildings subclass ($class) and pass the 'type' parameter");
    }
    my $realclass = $class->subclass_for($btype);
    return $realclass->new(%opt);
  }
  my $id = delete $opt{id};
  my $self = $class->SUPER::new(%opt);
  $self->{building_id} = $id;
  # We could easily support the body_id as default argument for ->build
  # here, but that would mean you had to specify the body_id at build time
  # or require building construction via $body->building(...)
  # Let's keep it simple for now.
  #$self->{body_id} = $opt{body_id};

  bless $self => $class;
  return $self;
}

sub build {
  my $self = shift;
  # assign id for this object after building
  my $rv = $self->_build(@_);
  $self->{building_id} = $rv->{building}{id};
  return $rv;
}

{
  my %type_for;

  sub type_for {
    my ($class, $hint) = @_;

    if (! keys %type_for) { # initialise mapping if needed
      %type_for = map { lc($_) => $_ }
        @Games::Lacuna::Client::Buildings::BuildingTypes,
        @Games::Lacuna::Client::Buildings::Simple::BuildingTypes;
    }

    $hint =~ s{.*/}{}mxs;
    $hint = lc($hint);
    return $type_for{$hint} || undef;
  }
}

sub type_from_url {
  my $url = shift;
  croak "URL is undefined" if not $url;
  $url =~ m{/([^/]+)$} or croak("Bad URL: '$url'");
  my $url_elem = $1;
  my $type = type_for(__PACKAGE__, $url) or croak("Bad URL: '$url'");
  return $type;
}

sub subclass_for {
  my ($class, $type) = @_;
  $type = $class->type_for($type);
  return "Games::Lacuna::Client::Buildings::$type";
}


__PACKAGE__->init();

1;
__END__

=head1 NAME

Games::Lacuna::Client::Buildings - The buildings module

=head1 SYNOPSIS

  use Games::Lacuna::Client;

=head1 DESCRIPTION