#!/usr/bin/perl
use strict;
use warnings;

use Getopt::Long;
use File::Spec;
use Data::Dumper;

use Java::Javap;
use Java::Javap::Grammar;
use Java::Javap::Generator;

my $genwith   = 'Std';
my $jpcmd     = '';
my $nest;
my $outdir    = '.';
my $recurse;

my %java_class_info;

#use Parse::RecDescent; $::RD_TRACE = 1;

# not yet done:
#   astas - no, make this a Genterator,
#           but do write the backends for YAML and Perl

# XXX nest and recurse should default on

GetOptions(
    'jpcmd|j=s'   => \$jpcmd,
    'genwith|g=s' => \$genwith,
    'genopts|p=s' => \my $opt_genopts,
    'nest|n!'     => \$nest,
    'outdir|d=s'  => \$outdir,
    'recurse|r!'  => \$recurse,
    'check|c!'    => \my $opt_check,
    'quiet|q!'    => \my $quiet,
    'trace|t=i'   => \(my $opt_trace = 1),
    'help|h!'     => \&help,
) or exit 1;

my @classes = @ARGV or die "usage: $0 [options] class [ class ... ]\nUse $0 --help for help\n";

# --quiet overrides trace level option
if ($quiet) {
    $opt_trace = 0;
}

$::RD_WARN  = 1;
$::RD_TRACE = 1 if $opt_trace >= 9;

my $parser = Java::Javap::Grammar->new();
my $caster = Java::Javap::TypeCast->new();
my $jenny  = Java::Javap::Generator->get_generator(
    $genwith,
    trace_level => $opt_trace,
    split(/\s+/, $opt_genopts||''),
);

my %check_status;

my %top_types;
foreach my $class ( @classes  ) {
    eval {
        my $types = load_java_class_info( $class, $recurse ) || [];
        $top_types{$_}++ for @$types;
    };
}

for my $class (sort keys %java_class_info) {
    my $info = $java_class_info{$class};
    # ignore clases just vivified for referred_to_by_classes
    next unless $info->{tree};

    # include the decompiled java for reference
    my @epilogue = ("=begin pod\n");
    if (my $refs = $info->{referred_to_by_classes}) {
        push @epilogue, "=head1 Referenced By\n";
        push @epilogue, "  $_" for sort @$refs;
        push @epilogue, "\n(Among the set of classes processed at the same time.)\n";
    }
    if (my @decomp = split /\n/, $info->{decomp}) {
        push @epilogue, "=head1 Java\n";
        push @epilogue, "  $_" for @decomp;
        push @epilogue, "\n";
    }
    push @epilogue, "=end pod\n";

    my $file_name = generate_output_file( {
        class_file  => $class,
        ast         => $info->{tree},
        javap_flags => $jpcmd,
        epilogue    => join("\n", '', @epilogue),
    });
    $info->{output_filename} = $file_name;
    warn "$info->{kind} $class: $file_name\n" if $opt_trace && $file_name;
}

for my $class (sort keys %java_class_info) {
    next unless $opt_check;

    my $info = $java_class_info{$class};
    my $file_name = $info->{output_filename}
        or next;

    warn "$info->{kind} $class: checking $file_name\n";
    if ($opt_trace) {
        warn "\t uses @{ $info->{refers_to_classes} }\n"
            if @{ $info->{refers_to_classes} };
        warn "\t used by @{ $info->{referred_to_by_classes} }\n"
            if @{ $info->{referred_to_by_classes} || [] };
    }

    (my $pirfile = $file_name) =~ s/\.pm6$/.pir/;
    # we're effectively doing perl6 -c here but we don't use -c
    # because it's noisy and we know we're only compiling modules
    my @perl6cmd = ("perl6", "--target=PIR", "--output=$pirfile", $file_name);
    local $ENV{PERL6LIB} = join(":",grep { $_ } $outdir,$ENV{PERL6LIB});
    warn "\t @perl6cmd\n" if $opt_trace;
    $check_status{$file_name} = (system(@perl6cmd) == 0);
}

if (%check_status) {
    my $passed = 0;
    for my $file_name (sort keys %check_status) {
        my $ok = $check_status{$file_name};
        printf "%6s: %s\n", ($ok ? "ok" : "FAILED"), $file_name;
        ++$passed if $ok;
    }
    printf "%d ok, %d failed.\n", $passed, keys(%check_status)-$passed;
}

if ($opt_trace >= 2) {
    print "Types used by specified classes:\n";
    printf "%s\n", $_ for sort keys %top_types;
}

exit 0;


sub load_java_class_info {
    my ($class, $recurse) = @_;
    my $pad = $recurse ? (". " x ($recurse-1)) : "";

    return undef if $java_class_info{$class}->{decomp};

    warn "$pad$class: loading\n" if $opt_trace;

    my $cmd = "javap $jpcmd $class";
    warn "$cmd\n" if $opt_trace >= 3;
    my $decomp = `$cmd`; # XXX check exit status
    warn $decomp if $opt_trace >= 3;
    my $tree   = $parser->comp_unit( $decomp )
        or die "Error parsing output of '$cmd'\n";

    # tell them which types are used by this class
    my $referenced_classes = Java::Javap->get_included_types( $tree, $caster );

    $java_class_info{$class} = {
        %{ $java_class_info{$class} || {} },
        decomp => $decomp,
        tree => $tree,
        refers_to_classes => $referenced_classes,
        kind => $tree->{class_or_interface},
    };

    push @{$java_class_info{$_}->{referred_to_by_classes}}, $class
        for @$referenced_classes;

    if ($recurse) {
        for my $ref_class (sort @$referenced_classes) {
            load_java_class_info( $ref_class, $recurse+1 );
        }
    }

    return $referenced_classes;
}



sub generate_output_file {
    my $params      = shift;
    my $epilogue = delete $params->{epilogue};

    my $output = $jenny->generate( $params );
        
    $output .= $epilogue if $epilogue;

    my $file_name;
    if ( $outdir eq 'STDOUT' ) {
        print $output; 
    }   
    else { # put it in a directory
        my $class = $params->{class_file};
        $file_name = output_filename_for_class($class, 1);
        open my $API_MODULE, '>', $file_name
            or die "Couldn't write to $file_name: $!\n";
        print $API_MODULE $output;
        close $API_MODULE or die "Error writing $file_name: $!\n";
    }
    
    return $file_name;
}       


sub output_filename_for_class {
    my ($class, $mkdir) = @_;

    my @subdirs    = split /\./, $class;
    my $class_name = pop @subdirs;

    my $module_dir = $outdir;
    mkdir $module_dir or -d $module_dir
        or die "Can't mkdir $module_dir: $!\n";
    if ( $nest ) {
        foreach my $subdir ( @subdirs ) {
            $module_dir = File::Spec->catdir( $module_dir, $subdir );
            mkdir $module_dir or -d $module_dir
                or die "Can't mkdir $module_dir: $!\n";
        }
    }
    return File::Spec->catfile( $module_dir, "$class_name.pm6" );
}


sub help {
    print <<'EO_Help';
java2perl6 [options] class_file [class_file...]

where options are:

    --jpcmd or -j     a string of command line flags for javap, example:
                      -j '-classpath /some/path'
    --genwith or -g   the name of a Java::Javap::Generator:: module which
                      will make the output, defaults to Std
    --genopts or -p   strings to pass to your -g constructor
    --nest or -n      flag indicates output should go in nested directories
    --outdir or -d    top level directory for output
    --quiet or -q     silences any output. Overrides --trace
    --trace or -t     defines the trace level (integer value), where:
                        0 means silence, no trace
                        1 is minimum trace messages (the default)
                        2..9 for more detail
    --help or -h      this message
EO_Help
    exit;
}

__END__

=head1 NAME

java2perl6 - a Java to Perl 6 API translator

=head1 SYNOPSIS

 java2perl6 [options] class_file

where the most frequently used options are:

 --nest or -n      place output files in nested directories
 --outdir or -d    top level directory for output
 --check           check the generated code compiles using perl6

other options

 --help or -h      this message
 --jpcmd or -j     a string of command line flags for javap, example:
                   -j '-classpath /some/path'
 --genwith or -g   the name of a Java::Javap::Generator:: module
                   which will make the output, defaults to Std
 --genopts or -p   strings to pass to your -g constructor
 --quiet or -q     silences any output. Overrides --trace
 --trace or -t     defines the trace level (integer value), where:
                   0 means silence, no trace,
                   1 is minimum trace messages,
                   >= 9 for full trace

=head1 DESCRIPTION

This script is the driver for the C<Java::Javap> module which reads compiled
Java files, parses them into a tree, and generates output in Perl 6.
Note that output could be in other forms if you write a generator,
see C<Java::Javap::Generator> for instructions on how to write one
and use the C<-g> command line flag once yours is installed.  This module
ships with only one generator: C<Java::Javap::Generator::Std>.

If you write your own generator, you could have it do anything you like
including outputing APIs in Perl 5, Python, etc.  I plan to add generators
for tree dumps using Data::Dumper and YAML.

=head1 EXAMPLES

To get a single Perl module in the java/sql subdirectory of the current
directory with an API translation of java.sql.Connection:

    java2perl6 -n java.sql.Connection

To get a single Perl module in the current directory with an API for
com.example.YourModule whose class file is in /usr/lib/yourjavas:

    java2perl6 -j '-classpath /usr/lib/yourjavas' com.example.YourModule

To put the output from the previous example into the /usr/local/javaapis
directory:

    java2perl6 -j '-classpath /usr/lib/yourjavas' \
        -d /usr/local/javaapis com.example.YourModule

To choose your own generator called C<Java::Javap::Generator::MyGen>
for the first example:

    java2perl6 -n -g MyGen java.sql.Connection

=head1 OPTIONS

=over 4

=item --help or -h

Prints a short help message (the same as the L<SYNOPSIS> above).

=item --jpcmd or -j

This option takes a single value, you need to quote it.  That value
is passed directly to C<javap>.  C<-classpath /some/path> is the most
common value.  Be aware that C<Java::Javap> parses the output of
C<javap> with a grammar, so some C<javap> flags will cause fatal errors.

=item --genwith or -g

C<Java::Javap> uses a factory approach to generation.  Basically, any
module in the Java::Javap::Generator:: namespace can be used here.  Give
the module's short name, so to get the default behavior explicitly type:

    java2perl6 -g Std ...

which will load and use C<Java::Javap::Generator::Std> to make
the output.  See C<Java::Javap::Generator> for the API your module
must respond to.

=item --genopts or -p

Not yet useful.

Any value given to this option will be passed to the generator's constructor.
These can obviously only be strings.  The Std generator does not support
any options, but future genertors may.

=item --outdir or -d

By default, all output is written in the current directory (or one of
its subdirectories, if you use C<--nest>).  Use this flag to specify
an alternate top level directory in which to place output.  It may
be relative to the current directory or absolute.  Remember that the
invoking user will need write permission on the directory.

=item --check or -c

Check the validity of the generated Perl 6 code by running it through
the C<perl6> binary.  Note C<perl6> must be in the PATH.

=item --nest or -n

By default all output is generated at the top level of the C<--outdir>.
Use this flag to make the normal subdirectories based on the namespace
of the Java package.  Thus, since com.example.Module will be called
com::example::Module, you probably want to use this flag so the output
will go into the com/example subdirectory of the output directory.

=item --quiet or -q

Turn this on to silence any output about what the script is doing. Currently it
is a boolean flag and overrides any trace level specified. See --trace
option.

=item --trace or -t

Integer value. Assign zero to it (--trace=0) to silence all messages from
the script. 1 is the minimum trace level. An integer >= 9 will emit full
trace messages.

=back

=head1 AUTHOR

Phil Crow E<lt>crow.phil@gmail.comE<gt>

=head1 COPYRIGHT and LICENSE

Copyright (c) 2007, Phil Crow

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.

=cut
vim: ts=8:sw=4:et
