#!/usr/bin/perl

# YOU DO NOT NEED TO RUN THIS SCRIPT!
#
# This is the script I use to generate the wrapper packages for distribution.
#


# Copyright 2006 Andrew Sterling Hanenkamp <hanenkamp@cpan.org>.  All Rights
# Reserved.
# 
# This module is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.
# 
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.

use strict;
use warnings;

use File::Basename;
use File::Path;
use YAML;

our $VERSION = '0.07';

our $PACKAGE_NAME = "Java::JCR";

my $config_file = $ARGV[0] || 'inc/packages.yml';
my $specials_file = $ARGV[1] || 'inc/specials.yml';

my $config = YAML::LoadFile($config_file);
my $specials = YAML::LoadFile($specials_file);

while (my ($java_package, $package_config) = each %$config) {
    my $perl_package = $java_package;
    $perl_package =~ s/^javax\.jcr\./${PACKAGE_NAME}::/;
    $perl_package =~ s/(\p{IsLl}+)\.([\w\$]+)$/\u$1\E::$2/;
    $perl_package =~ s/\$/::/;

    my $inline_package = $java_package;
    $inline_package =~ s/\.|\$/::/g;
    $inline_package = $PACKAGE_NAME."::$inline_package";

    $package_config->{perl_package} = $perl_package;
    $package_config->{inline_package} = $inline_package;
}

while (my ($java_package, $package_config) = each %$config) {
    # We don't need no stinkin' exceptions
    next if $java_package =~ /Exception$/;

    my $perl_package = $package_config->{perl_package};
    my $inline_package = $package_config->{inline_package};

    my $package_file = $perl_package;
    $package_file =~ s/::/\//g;
    $package_file = 'lib/'.$package_file.'.pm';

    my $package_dir = dirname($package_file);

    mkpath($package_dir, 1);

    my $fh;
    open $fh, '>', $package_file or die "failed to open $package_file";

    print STDERR "Writing $package_file\n";

    my @isa = qw( Java::JCR::Base );

    for my $isa (@{ $package_config->{isa} }) {
        if (defined $config->{$isa}) {
            push @isa, $config->{$isa}{perl_package};
        }
    }

    my $isa_str = join ' ', @isa;

    print $fh <<"END_OF_PERL";
package $perl_package;

# This code was automatically generated by a combination of the
# JCRPackageGenerator.java and package-generator.pl programs. These are both
# distributed in the inc/ directory of the Java-JCR distribution. You should
# be able to find the latest Java-JCR distribution at:
#
#   http://search.cpan.org/~hanenkamp/Java-JCR/
#

use strict;
use warnings;

use base qw( $isa_str );

our \$VERSION = '$VERSION';

use Carp;
use Inline (
    Java => 'STUDY',
    STUDY => [],
);
use Inline::Java qw( study_classes );

study_classes(['$java_package'], 'Java::JCR');

END_OF_PERL

    if ($package_config->{has_constructors}) {
        if (defined $specials->{$java_package}{'new'}) {
            print $fh $specials->{$java_package}{'new'}, "\n\n";
        }

        else {
            print $fh <<"END_OF_PERL";
sub new {
    my \$class = shift;

    my \$obj = eval { $inline_package->new(\@_) };
    if (\$@) { my \$e = Java::JCR::Exception->new(\$@); croak \$e }

    return bless { 
        obj => \$obj,
    }, \$class;
}

END_OF_PERL
        }
    }

    if (defined $package_config->{static_fields}) {
        for my $field (@{ $package_config->{static_fields} }) {
            print $fh <<"END_OF_PERL";
*$field = *${inline_package}::$field;
END_OF_PERL
        }
        
        print $fh "\n";
    }

    if (defined $package_config->{methods}{static}) {
        while (my ($method_name, $return_type) 
                = each %{ $package_config->{methods}{static} }) {

            my $perl_method_name = $method_name;
            $perl_method_name =~ s/(\p{IsLu}+)/_\L$1\E/g;

            if (defined $specials->{$java_package}{$perl_method_name}) {
                print $fh $specials->{$java_package}{$perl_method_name},"\n\n";
            }

            else {

                my $return_line;
                if ($return_type =~ /^Array:(.*)$/ && defined $config->{$1}) {
                    $return_line
                        = 'Java::JCR::Base::_process_return($result, "'
                            .$return_type.'", "'
                            .$config->{$1}{perl_package}.'")';
                }

                elsif (defined $config->{$return_type}) {
                    $return_line 
                        = 'Java::JCR::Base::_process_return($result, "'
                            .$return_type.'", "'
                            .$config->{$return_type}{perl_package}.'")';
                }

                else {
                    $return_line = '$result';
                }

                print $fh <<"END_OF_PERL";
sub $perl_method_name {
    my \$class = shift;
    my \@args = Java::JCR::Base::_process_args(\@_);

    my \$result = eval { ${inline_package}->$method_name(\@args) };
    if (\$@) { my \$e = Java::JCR::Exception->new(\$@); croak \$e }

    return $return_line;
}

END_OF_PERL
            }
        }
    }

    if (defined $package_config->{methods}{instance}) {
        while (my ($method_name, $return_type) 
                = each %{ $package_config->{methods}{instance} }) {

            my $perl_method_name = $method_name;
            $perl_method_name =~ s/(\p{IsLu}+)/_\L$1\E/g;

            if (defined $specials->{$java_package}{$perl_method_name}) {
                print $fh $specials->{$java_package}{$perl_method_name},"\n\n";
            }

            else {

                my $return_line;
                if ($return_type =~ /^Array:(.*)$/ && defined $config->{$1}) {
                    $return_line
                        = 'Java::JCR::Base::_process_return($result, "'
                            .$return_type.'", "'
                            .$config->{$1}{perl_package}.'")';
                }

                elsif (defined $config->{$return_type}) {
                    $return_line 
                        = 'Java::JCR::Base::_process_return($result, "'
                            .$return_type.'", "'
                            .$config->{$return_type}{perl_package}.'")';
                }

                else {
                    $return_line = '$result';
                }


                print $fh <<"END_OF_PERL";
sub $perl_method_name {
    my \$self = shift;
    my \@args = Java::JCR::Base::_process_args(\@_);

    my \$result = eval { \$self->{obj}->$method_name(\@args) };
    if (\$@) { my \$e = Java::JCR::Exception->new(\$@); croak \$e }

    return $return_line;
}

END_OF_PERL
            }
        }
    }

    my $documentation_package = $java_package;
    $documentation_package =~ s/\./\//g;
    $documentation_package = 'http://www.day.com/maven/jsr170/javadocs/jcr-1.0/'.$documentation_package.'.html';

    print $fh <<"END_OF_PERL";
1;
__END__

=head1 NAME

$perl_package - Perl wrapper for $java_package

=head1 DESCRIPTION

This is an automatically generated package wrapping $java_package with a nice Perlish API.

For full documentation of what this class does, see the Java API documentation: L<$documentation_package>

The deviations from the API documentation include the following:

=over

=item *

You will need to use Perl, intead of Java, to make any use of this API. (Duh.)

=item *

The package to use is L<$perl_package>, rather than I<$java_package>.

=item *

All method names have been changed from Java-style C<camelCase()> to Perl-style C<lower_case()>. 

Thus, if the function were named C<getName()> in the Java API, it will be named C<get_name()> in this API. As another example, C<nextEventListener()> in the Java API will be C<next_event_listener()> in this API.

=item *

Handle exceptions just like typical Perl. L<Java::JCR::Exception> takes care of making sure that works as expected.

=back

=head1 SEE ALSO

L<Java::JCR>, L<$documentation_package>

=head1 AUTHOR

Andrew Sterling Hanenkamp, E<lt>hanenkamp\@cpan.orgE<gt>

=head1 LICENSE AND COPYRIGHT

Copyright 2006 Andrew Sterling Hanenkamp E<lt>hanenkamp\@cpan.orgE<gt>.  All 
Rights Reserved.

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>.

This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE.

=cut

END_OF_PERL

    close $fh;
}