#!/usr/local/bin/perl -w

=for test_script t/bin-stml.t

=cut

use strict ;
use StateML ;

use File::Basename ;
use Getopt::Long ;

my $as_png ;
my $as_dot ;

my %formats = (
    "eps"    => "as_ps",      # Allow a better extension than .ps
    "dot"    => "as_canon",
    "bmp"    => "as_wbmp",
    "predot" => "_as_debug",  ### This is an undocumented GraphViz call.
    ( 
        map { ( $_ => "as_$_" ) } qw(
            gif jpeg plain png ps
        )
    ),
) ;

my $output_format ;
sub usage ;

my %defines;
my $interpolate_vars;
my $only_for_back_compat;
my $output_method;
my $output_fn;
my $show_description;
my $show_handlers;
my $show_ids;
my $template_file;
my @types;
my @modes;

my %graph_options;  ## These should be parsed by a dedicated graphviz
                    ## driver so STML can support other output methods
                    ## one day.
{
    {
        my %types;
        my %format_options;

        GetOptions(
            \%format_options,
            keys %formats,    ## All formats ('png', etc) are --options

            "define|d=s@"     => sub {
                my ( $name, $value ) = split /=/, pop, 2;
                $defines{$name} = $value;
            },

            "except-type=s@",  => sub {
                @types{map "!$_", split /\s*,\s*/, pop} = ()
            },
            "font-size=s"      => \$graph_options{font_size},
            "help|H|?"         => sub { usage },
            "interpolate-vars" => \$interpolate_vars,
            "modes=s"          => sub { push @modes, split /\s*,\s*/, pop },
            "no-handlers"      => \$only_for_back_compat,
            "page-size=s"      => \$graph_options{page_size},
            "show-handlers"    => \$graph_options{show_handlers},
            "show-ids"         => \$graph_options{show_ids},
            "show-description" => \$graph_options{show_description},
            "type=s@",         => sub { @types{split /\s*,\s*/, pop} = () },
            "template=s"       => \$template_file,
        ) or usage "" ;

        @types          = sort keys %types ;
        if ( keys %format_options > 1 ) {
            usage "Multiple output formats specified (",
                join( ", ", map "--$_", sort keys %format_options ),
                ")." ;
        }

        $output_format = (keys %format_options)[0] ;
    }

    usage "Output format --$output_format contradicts --template option."
        if defined $template_file and defined $output_format ;

    $output_format = "template" if $template_file ;

    ## Pipe from stdin through to stdout if no filenames specified
    push @ARGV, "-" unless @ARGV ;
    push @ARGV, "-" unless @ARGV > 1 ;

    $output_fn = pop ;

    unless ( defined $output_format ) {
        ## No output format requested, intuit one from
        ## the output file's extension.
        my (undef, undef, $ext) = fileparse $output_fn, '\.[^.]*' ;
        if ( defined $ext and length $ext ) {
            $ext =~ s/^\.// ;
            usage "Unrecognized output format: '.$ext'."
                unless exists $formats{$ext} ;
            $output_format = $ext ;
        }
    }

    if ( ! defined $template_file ) {
        usage "No output option specified or inferred from output filename."
            unless defined $output_format ;

        $output_method = $formats{$output_format} ;
    }

}

my $tt2 ;
my $template ;

my $autogenerated_warning;

my $machine = StateML::Machine->new ;

if ( defined $template_file ) {
    require Template ;

    $tt2 = Template->new(
        ## Turn on convenience features
        INTERPOLATE  => $interpolate_vars, # expand "$var" in plain text
#        POST_CHOMP   => 1,               # cleanup whitespace

        ## We're a command line tool, not a server-side too,
        ## so trust the OS's security system to prevent mischief
        EVAL_PERL    => 1,               # evaluate Perl code blocks
        ABSOLUTE     => 1,               # allow absolute filenames in includes
        RELATIVE     => 1,               # allow relative filenames in includes
    );

    $autogenerated_warning =
        "DO NOT EDIT!!! GENERATED FROM $template_file by $0 AT " . localtime();

    $template_file = \*STDIN
        if $template_file eq "-" ;

    $template = $tt2->context->template( $template_file ) ;

    ## Support deprecated method
    $machine->autogenerated_message( $autogenerated_warning );
}

## Set the modes so that elements with this prefix get
## "promoted" (or demoted, if you prefer) to be StateML elements.
## This is a crude way of allowing multiple languages in the source
## document without the overhead of attributes.  Later, we should
## implement this using real namespaces.
if ( defined $template ) {
    $machine->modes( $machine->modes, $template->modes );
}

my $stdin_cnt = defined $template_file && $template_file eq "-" ;

for ( @ARGV ) {
    my $source ;
    if ( $_ eq "-" ) {
        die "Cannot read multiple files from stdin\n" if $stdin_cnt++ ;
        $source = {
            ByteStream => \*STDIN,
            SystemId   => "stdin"
        } ;
    }
    else {
        $source = { SystemId => $_ } ;
    }

    StateML->parse( $source, $machine ) ;
}

#require Data::Dumper ; warn Data::Dumper::Dumper( $machine ) ;

## Make sure the machine is valid
$machine->assert_valid ;

if ( $output_fn ne "-" ) {
    open STDOUT, ">$output_fn" or die "$!: $output_fn\n" ;
}

## Apply the command line filters
$machine = $machine->extract_output_machine(
    types => \@types,
    raw   => ! defined $template_file,
) ;

if ( defined $template_file ) {
    $tt2->process( $template, {
        machine => $machine,
        ENV     => \%ENV,
        autogenerated_warning => $autogenerated_warning,
        %defines
    } ) or die $tt2->error();
}
else {
    my $graph = $machine->as_GraphViz( \%graph_options ) ;
    binmode STDOUT unless $output_method =~ /^as_(.*dot|debug)$/ ;
    print $graph->$output_method() or die $! ;
}

sub usage {
    push @_, "\n\n" if @_ ;
    print STDERR join( "", @_ ), <<TOHERE,
Usage:
    cat foo.stml | stml --png > foo.png
    stml foo.stml --png > foo.png
    stml foo.stml file2.stml ... foo.png

Options may appear anywhere on the command line.

** Output Format Options (use only one):
    --template=t        Apply template file "t" to generate output
TOHERE
        map( "    --$_\n", sort keys %formats ),
        <<TOHERE ;

** Other Options:
    --type=A,B,C      only display events of types A, B, C, and #ANY
    --except-type=A,B,C  only display events other than types A, B, C, and #ANY
    --no-handlers     supress display of handler routines
    --font-size=12    Use 12 pt fonts instead of 10
    --page-size=10x16 Size for 11x17 paper instead of 8.5x11
    --define A=B      Pass a variable A with the value B to the template
    --interpolate-vars Expand \$var constructs in templates

See the dot manpage (from the GraphViz package) for descriptions of the
output image formats.

If no output format option (e.g. --png) is given, the extension of the
output filename is used.

** WARNING: Alpha code alert.  APIs and basic functionality are susceptible
to change.

** The Special Filename "-"

Using a "-" (a single dash) as a input, template, or output causes stml
to read the appropriate file from stdin or write it to stdout.  Only one
file may be read from stdin, but "-" may be used to read from stdin and
write from stdout.

TOHERE

   exit @_ ? 1 : 0 ;
}