#!/usr/local/bin/perl
# atopojo.pl - Generate MUD inter-area topology as JSON
#
# Copyright 2015 David Meyer <papa@sdf.org> +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 <papa@sdf.org>

=head1 HISTORY

=head1 COPYRIGHT AND LICENSE

Copyright 201x David Meyer

=head1 SEE ALSO



# Emacs control #####################################################
#Local variables:
#mode: perl
#End: