#!/usr/bin/perl -w
package MudConvert::API;
use strict;
use English;
use base 'Exporter';
our @EXPORT_OK = qw(
zone_name
room_name
mob_name
obj_name
zone_span
zone_reset_desc
exit_name
exit_type_desc
exit_flag_list
flags_value
);
sub _check_vnum {
my $data = shift;
my $id = shift;
return undef if !(defined $data) or !(defined $id) or (length $id) < 1;
return 1 if $id =~ /^\-?\d+$/ and (defined $data->{$id}) and (defined $data->{$id}->{'Name'});
return undef;
}
sub _get_prop {
my $data = shift;
my $id = shift;
my $field = shift || 'Name';
return undef if !(defined $data) or !(defined $id) or (length $id) < 1;
if( $id =~ /^\-?\d+$/ ) { #vnum
return $data->{$id}->{$field} if (defined $data->{$id});
} else {
return $id if( grep { $_->{$field} eq $id } ( keys %{$data} ) );
}
}
sub _get_name {
my $data = shift;
my $id = shift;
my $name = _get_prop($data, $id, 'Name');
return (defined $name) ? $name : 'UNKNOWN';
}
sub zone_name {
my $data = shift;
return 'UNKNOWN' if !(defined $data) or !(defined $data->{'Zones'});
return _get_name($data->{'Zones'}, @_);
}
sub room_name {
my $data = shift;
return 'UNKNOWN' if !(defined $data) or !(defined $data->{'Rooms'});
return _get_name($data->{'Rooms'}, @_);
}
sub mob_name {
my $data = shift;
return 'UNKNOWN' if !(defined $data) or !(defined $data->{'Mobs'});
return _get_name($data->{'Mobs'}, @_);
}
sub obj_name {
my $data = shift;
return 'UNKNOWN' if !(defined $data) or !(defined $data->{'Objects'});
return _get_name($data->{'Objects'}, @_);
}
sub zone_span {
my $data = shift;
my $vnum = shift;
return (-1,-1) if !(defined $data) or !(defined $data->{'Zones'}) or !(defined $vnum);
return (-1,-1) if !_check_vnum($data->{'Zones'}, $vnum);
for( my ($i, $x) = (0, [ sort { $a <=> $b } keys %{ $data->{'Zones'} } ]); $i < scalar(@{ $x }); $i++) {
my $vnum = $x->[$i];
next if $vnum < $vnum;
last if $vnum > $vnum;
return ( ((!$i)? 0: $data->{'Zones'}->{$x->[$i-1]}->{'Top'} + 1), $data->{'Zones'}->{$vnum}->{'Top'} );
}
return (-1,-1);
}
sub zone_reset_desc {
my $data = shift;
my $vnum = shift;
my $zone_reset_map = {
'RESET_UNKNOWN' => "I do not know how it resets.",
'RESET_NEVER' => "It NEVER resets.",
'RESET_PC' => "It resets every %d minutes, if NO players are present.",
'RESET_ALWAYS' => "It ALWAYS resets every %d minutes.",
};
return 'UNKNOWN' if !(defined $vnum) or (length $vnum) < 1 or !(defined $data) or !(defined $data->{'Zones'});
if( ($vnum =~ /^\-?\d+$/) and (defined $data->{'Zones'}->{$vnum}) ) {
my $mode = $data->{'Zones'}->{$vnum}->{'Mode'};
my $time = $data->{'Zones'}->{$vnum}->{'Time'};
return sprintf( $zone_reset_map->{$mode}, $time )
if (defined $data->{'Zones'}->{$vnum}->{'Mode'})
and (defined $data->{'Zones'}->{$vnum}->{'Time'})
and grep /^$mode$/, (keys %{ $zone_reset_map });
} else {
print STDERR "WARNING: Unknown ZONE RESET TYPE for Zone #$vnum\n";
}
return 'UNKNOWN';
}
sub exit_name {
my $id = shift;
my $exit_direction_map = {
'EXIT_NONE' => 'NONE',
'EXIT_NORTH' => 'North',
'EXIT_EAST' => 'East',
'EXIT_SOUTH' => 'South',
'EXIT_WEST' => 'West',
'EXIT_UP' => 'Up',
'EXIT_DOWN' => 'Down',
};
return 'UNKNOWN' if !(defined $id) or (length $id) < 1;
if( $id =~ /^\-?\d+$/ ) {
print STDERR "FATAL: Untranslated EXIT DIRECTION\n";
} else {
return $exit_direction_map->{$id} if grep /^$id$/, (keys %{ $exit_direction_map });
}
return 'UNKNOWN';
}
sub exit_type_desc {
my $id = shift;
my $exit_type_map = {
'EXIT_INVALID' => "a BROKEN Exit",
'EXIT_OPEN' => "an Open Passage",
'EXIT_DOOR' => "a Door",
'EXIT_NOPICK' => "an Unpickable Door",
'EXIT_SECRET' => "a Secret Door",
'EXIT_SECRET_NOPICK' => "an Unpickable Secret Door",
'EXIT_OPEN_ALIAS' => "an Aliased Open Passage",
'EXIT_DOOR_ALIAS' => "an Aliased Door",
'EXIT_NOPICK_ALIAS' => "an Aliased Unpickable Door",
'EXIT_SECRET_ALIAS' => "an Aliased Secret Door",
'EXIT_SECRET_NOPICK_ALIAS' => "an Aliased Unpickable Secret Door",
};
return 'UNKNOWN' if !(defined $id) or (length $id) < 1;
if( $id =~ /^\-?\d+$/ ) {
print STDERR "FATAL: Untranslated EXIT TYPE\n";
} else {
return $exit_type_map->{$id}
if (defined $exit_type_map->{$id});
}
return 'UNKNOWN';
}
sub exit_flag_list {
my $id = shift;
my $exit_flag_map = {
'EXIT_INVALID' => [],
'EXIT_OPEN' => [],
'EXIT_DOOR' => [ 'EXITFLAG_DOOR' ],
'EXIT_NOPICK' => [ 'EXITFLAG_DOOR', 'EXITFLAG_NOPICK' ],
'EXIT_SECRET' => [ 'EXITFLAG_DOOR', 'EXITFLAG_SECRET' ],
'EXIT_SECRET_NOPICK' => [ 'EXITFLAG_DOOR', 'EXITFLAG_NOPICK', 'EXITFLAG_SECRET' ],
'EXIT_OPEN_ALIAS' => [ 'EXITFLAG_ALIAS' ],
'EXIT_DOOR_ALIAS' => [ 'EXITFLAG_DOOR', 'EXITFLAG_ALIAS' ],
'EXIT_NOPICK_ALIAS' => [ 'EXITFLAG_DOOR', 'EXITFLAG_NOPICK', 'EXITFLAG_ALIAS' ],
'EXIT_SECRET_ALIAS' => [ 'EXITFLAG_DOOR', 'EXITFLAG_SECRET', 'EXITFLAG_ALIAS' ],
'EXIT_SECRET_NOPICK_ALIAS' => [ 'EXITFLAG_DOOR', 'EXITFLAG_NOPICK', 'EXITFLAG_SECRET', 'EXITFLAG_ALIAS' ],
};
return [] if !(defined $id) or (length $id) < 1;
if( $id =~ /^\-?\d+$/ ) {
print STDERR "FATAL: Untranslated EXIT TYPE\n";
} else {
return $exit_flag_map->{$id}
if (defined $exit_flag_map->{$id});
}
return [];
}
sub flags_value {
my $ref = shift;
my $conversion = shift;
return 0 if !(defined $ref) or !(defined $conversion);
my $a = join(' + ', map { $conversion->{$_} } @{ $ref });
$a = eval $a;
return $a;
}
1;
