#!/usr/local/bin/perl
# atopojo.pl - Generate MUD inter-area topology as JSON
#
# Copyright 2015 David Meyer <
[email protected]> +JMJ
# (License and documentation at bottom of file.)
use strict;
use warnings;
use Getopt::Std;
use File::Basename;
use JSON;
our (%AREA, %RMAREA, @RMLINK);
%FSM::STATE = (SKIP => 0,
AREA => 1,
ROOMS => 2,
PENDRNAME => 3,
PENDRDESC => 4,
WAITDOOR => 5,
PENDDDESC => 6,
PENDDKW => 7,
PENDDLKD => 8);
$FSM::state = $FSM::STATE{SKIP};
sub parse_are_fsm {
my($afile, $aline) = @_;
if ($FSM::state == $FSM::STATE{SKIP}) {
if ($aline =~ /^#AREA ({\d+ \d+} \w+ )?(.*)~$/) {
$FSM::areaname = $2;
# my ($path, $base, $ext) = fileparse($afile, qr/\.[^.]*$/);
$afile =~ m:(.*/)?(.*)\.[^.]*:;
$FSM::areaid = $2;
$AREA{$FSM::areaid} = {FILE => $afile, NAME => $FSM::areaname};
$FSM::state = $FSM::STATE{AREA};
}
}
elsif ($FSM::state == $FSM::STATE{AREA}) {
if ($aline =~ /^#ROOMS$/) {
$FSM::state = $FSM::STATE{ROOMS};
}
elsif ($aline =~ /^#$$/) {
$FSM::state = $FSM::STATE{SKIP};
}
}
elsif ($FSM::state == $FSM::STATE{ROOMS}) {
if ($aline =~ /^#(\d+)$/) {
$FSM::room = $1;
$RMAREA{$FSM::room} = $FSM::areaid;
$FSM::state = $FSM::STATE{PENDRNAME};
}
elsif ($aline =~ /^#0$/) {
$FSM::state = $FSM::STATE{AREA};
}
}
elsif ($FSM::state == $FSM::STATE{PENDRNAME}) {
if ($aline =~ /~$/) {
$FSM::state = $FSM::STATE{PENDRDESC};
}
}
elsif ($FSM::state == $FSM::STATE{PENDRDESC}) {
if ($aline =~ /~$/) {
$FSM::state = $FSM::STATE{WAITDOOR};
}
}
elsif ($FSM::state == $FSM::STATE{WAITDOOR}) {
if ($aline =~ /^D(\d+)$/) {
$FSM::exdir = $1;
$FSM::state = $FSM::STATE{PENDDDESC};
}
elsif ($aline =~ /^S$/) {
$FSM::state = $FSM::STATE{ROOMS}
}
}
elsif ($FSM::state == $FSM::STATE{PENDDDESC}) {
if ($aline =~ /~$/) {
$FSM::state = $FSM::STATE{PENDDKW};
}
}
elsif ($FSM::state == $FSM::STATE{PENDDKW}) {
if ($aline =~ /~$/) {
$FSM::state = $FSM::STATE{PENDDLKD};
}
}
elsif ($FSM::state == $FSM::STATE{PENDDLKD}) {
if ($aline =~ /^\w+ \w+ (\d+)$/) {
# print "test: $1/$aline";
$FSM::exdest = $1;
push @RMLINK, [$FSM::room, $FSM::exdest];
$FSM::state = $FSM::STATE{WAITDOOR};
}
}
else {
die "Invalid state processing file $afile line $.";
}
}
our %OPTIONS = ();
getopts('f:', \%OPTIONS);
if (defined($OPTIONS{f})) {
open(my $FLIST, "<", $OPTIONS{f}) or die "Can't open file $OPTIONS{f}: $!";
my @afiles;
while (<$FLIST>) {
chop $_;
if ($_ eq '$') {last;}
push @afiles, $_;
}
foreach my $afile (@afiles) {
open(my $AF, "<", $afile) or die "Can't open file $afile: $!";
while (<$AF>) {
parse_are_fsm($afile, $_);
}
}
}
else {
while (<>) {
parse_are_fsm($ARGV, $_);
}
}
foreach my $area (keys %AREA) {
print "AREA $area\t$AREA{$area}{FILE}\t$AREA{$area}{NAME}\n";
}
foreach my $rm (keys %RMAREA) {
print "RMAREA $rm\t$RMAREA{$rm}\n";
}
foreach my $link (@RMLINK) {
print "RMLINK ", join("\t", @$link), "\n";
}
exit 0
__END__
# Documentation #####################################################
=head1 NAME
template.pl - Perl script template (command line)
=head1 SYNOPSIS/USAGE
=head1 DESCRIPTION
Mark up code elements with C<>, file names with F<> (or C<> for
readability), command names with B<>. Also I<> for italics, U<> for
underline. Entities: E<lt> ('<'), E<gt> ('>').
=head1 OPTIONS
=item B<-o> I<value>, B<--option>=I<value>
=head1 RETURN VALUE
=head1 ERRORS
=head1 DIAGNOSTICS
=head1 EXAMPLES
=head1 ENVIRONMENT
=over 6
=item VARIABLE
Description of usage of environment variable C<VARIABLE>.
=back
=head1 FILES
=head1 BUGS, LIMITATIONS, AND CAVEATS
=head1 NOTES
=head1 AUTHOR
David Meyer <
[email protected]>
=head1 HISTORY
=head1 COPYRIGHT AND LICENSE
Copyright 201x David Meyer
=head1 SEE ALSO
# Emacs control #####################################################
#Local variables:
#mode: perl
#End:
