#!/usr/bin/perl

# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ''AS IS'' AND ANY
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# Igor Vlasenko <viy@altlinux.org>.
# perl port of maven_depmap.py script by
# Stanislav Ochotnicky <sochotnicky@redhat.com>
#
# this script is used by add_maven_depmap rpm macro to generate
# mapping between maven groupId:artifactId and jar file in our local
# filesystem (i.e. %{_javadir})
# rpm macro expects to find this file as %{_datadir}/java-utils/maven_depmap.py

use strict;
use warnings;
use Getopt::Long;
use File::Basename;
use File::Path qw(make_path remove_tree);

# if slow ...
#use XML::LibXML;
use XML::Simple;

my $append_deps;
my $maven_repo;
my $versions;
my $verbose=0;
my $result = GetOptions (
    "a|append=s"   => \$append_deps,
    "m|maven-repo=s" => \$maven_repo,
    "r|versions=s" =>\$versions,
    "verbose"  => \$verbose
);

sub usage() {
    print "usage: $0 [options] fragment_path pom_path [jar_path]
    Options:
	-a,--append gid:aid  Additional depmaps to add (gid:aid)
	-m,--maven-repo path Where to create Maven repository layout
	-r,--versions list   Additional versions to add for each depmap
"
}

#### BEGIN DEBUG ####
#use Data::Dumper;
#my $tfragment=&parse_pom($ARGV[0]);
#print Dumper($tfragment);
#exit;
##### END DEBUG #####
#####################

if (@ARGV < 2) {
    die("Incorrect number of arguments");
}

my ($jar_path, $fragment);
my $fragment_path = $ARGV[0];
my $pom_path = $ARGV[1];
print $fragment_path,"\n";
print $pom_path,"\n";
if (@ARGV == 3) {
    $jar_path = $ARGV[2];
    print $jar_path,"\n";
    $fragment = &parse_pom($pom_path, $jar_path);
} else {
    $fragment = &parse_pom($pom_path);
}
if ($fragment) {
    my $mappings = &create_mappings($fragment, $append_deps);
    &output_fragment($fragment_path, $fragment, $mappings, $versions);
    if ($maven_repo) {
	&create_maven_repo($maven_repo, $fragment, $mappings);
    }
} else {
    die "Problem parsing pom file $pom_path. Is it valid maven pom?";
}

sub create_mappings {
    my ($fragment, $additions)=@_;
    my @additions=([$fragment->{-gid}, $fragment->{-aid}]);
    if ($additions) {
        foreach my $add (split (',',$additions)) {
            my ($g, $a) = split(':', $add);
            push @additions, [$g, $a];
	}
    }
    return \@additions;
}

# Writes fragment into fragment_path in specialised format compatible with jpp
sub output_fragment {
    my ($fragment_path, $fragment, $mappings, $versions) = @_;
    if (not $versions) {
	$versions = [];
    } else {
	$versions = [split(',',$versions)];
    }
    unshift @$versions, $fragment->{-version};
    open(my $ffile, '>>',  $fragment_path) || die "$!: can't open $fragment_path";
    foreach my $ver (@$versions) {
	foreach my $m (@$mappings) {
	    my ($gid, $aid) = ($m->[0],$m->[1]);
	    print $ffile "
<dependency>
    <maven>
        <groupId>$gid</groupId>
        <artifactId>$aid</artifactId>
        <version>$ver</version>
    </maven>
    <jpp>
        <groupId>$fragment->{-local_gid}</groupId>
        <artifactId>$fragment->{-local_aid}</artifactId>
        <version>$ver</version>
    </jpp>
</dependency>
";
	}
    }
    close ($ffile);
}

# Create maven repository layout from fragment in given repository
sub create_maven_repo {
    my ($repo_path, $fragment, $mappings)=@_;

    # subdirectory under _javadir (if any)
    my $javadir_sub = $fragment->{-local_gid};
    $javadir_sub =~ s/JPP//g;

    foreach my $m (@$mappings) {
	my ($gid, $aid) = ($m->[0],$m->[1]);
	my $gidpath=$gid;
	$gidpath=~s!\.!/!g;
	my $repo_subdir = join('/',$gidpath,
			       $aid,
			       $fragment->{-version});
 
        my $final_dir = join('/',$repo_path,$repo_subdir);
        # create directory structure first
        make_path($final_dir);
	print $final_dir,"\n";

        # we want relative paths for symlinks so we need to know how many levels
        # deep we are in the repository
        my $gid_dircount = &__count_dot($gid);
        my $relative_datadir = '../' x ($gid_dircount+4);
        if ($fragment->{-packaging} ne 'pom') {
            &symlink(join('/',$relative_datadir,
                                    'java',
                                    $javadir_sub,
                                    $fragment->{-local_aid}.'.'.$fragment->{-packaging}),
		     join('/',$final_dir,$aid.'-'.$fragment->{-version}.'.'.$fragment->{-packaging}));
	}
        my $pom_fname = "JPP";
	if ($javadir_sub ne '') {
            $pom_fname = $pom_fname.'.'.$javadir_sub;
	}
	$pom_fname = $pom_fname.'-'.$fragment->{-local_aid}.'.pom';
	&symlink(join('/',$relative_datadir, 'maven-poms', $pom_fname),
		 join('/',$final_dir,$aid.'-'.$fragment->{-version}.'.pom'));
    }
}

our ($counter,$cnt);
sub __count_dot {
    my $arg=shift;
    local $counter=0;
    $arg=m<
            (?{ $cnt = 0 })                    # Initialize $cnt.
            (
              [^\.]*\.
              (?{
                  local $cnt = $cnt + 1;       # Update $cnt, backtracking-safe.
              })
            )*
            (?{ $counter = $cnt })             # On success copy to non-localized
                                               # location.
          >x;
    return $counter;
}

sub symlink {
    my ($a,$b)=@_;
    system('ln','-s',$a,$b)==0 or die "ln -s $a $b failed!";
}

sub raise_IncompatibleFilenames {
    my ($pom_path, $jar_path) = @_;
    die "Filenames of pom $pom_path and jar $jar_path does not match properly. Check that jar subdirectories match '.' in pom name.";
}

#    """Get resolved (groupId,artifactId) tuple from pom and jar path
#
#    pom name and jar name have to be compatible.
#    JPP.xbean-xbean-main.pom means groupId is "JPP/xbean" and artifactid
#    is "xbean-main". Therefore for jar name to be compatible it has be
#    in %{_javadir}/xbean/xbean-main.jar
#    """
sub _get_jpp_from_filename {
    my ($pom_path, $jar_path) = @_;
    # this is not nice, because macros can change but handling these
    # in rpm macros is ugly as hell
    my @javadirs=("/usr/share/java", "/usr/share/java-jni", "/usr/lib/java",
		  "/usr/lib64/java");
    my $pomname = basename($pom_path);
    my ($jpp_gid,$jpp_aid);
    if ($jar_path) {
        if (not -f $jar_path) {
            die("Jar path $jar_path doesn't exist");
	}	
        my $jarpart; # compound part like ant/ant-oro.jar
        for my $jdir (@javadirs) {
            if ($jar_path =~m!^.*$jdir/(.*)$!) {
                $jarpart = $1;
		last;
	    }
	}
	raise_MissingJarFile($jar_path) if not $jarpart;

        if ($pomname =~ m'^JPP\.') {
	    if ($jarpart !~ m!/!) {
		raise_IncompatibleFilenames($pom_path, $jar_path);
	    }
	    my $dirname = dirname($jarpart);
            $jpp_gid = "JPP/" . $dirname;
	    $jpp_aid = basename($jarpart);
	    $jpp_aid =~s/\.(jar|pom)$//;
            # we assert that jar and pom parts match
            if (not $pomname eq "JPP.$dirname-${jpp_aid}.pom") {
                &raise_IncompatibleFilenames($pom_path, $jar_path);
	    }
	} else {
	    if ($jarpart =~ m!/!) {
		raise_IncompatibleFilenames($pom_path, $jar_path);
	    }
            $jpp_gid = "JPP";
            $jpp_aid = basename($jarpart);
	    $jpp_aid =~s/\.(jar|pom)$//;
            # we assert that jar and pom parts match
            if (not $pomname eq "JPP-${jpp_aid}.pom") {
                &raise_IncompatibleFilenames($pom_path, $jar_path);
	    }
	}
    } else {
        if ($pomname =~ m'^JPP\.') {
            $pomname =~ m'^JPP\.([^-]*?)-.*$';
            $jpp_gid="JPP/$1";
            $pomname =~ m'^JPP\.[^-]*?-(.*)\.pom$';
            $jpp_aid= $1;
	} else {
            $jpp_gid = "JPP";
            $jpp_aid = $pomname;
	    $jpp_aid =~ s/^JPP.//;
	}
    }
    $jpp_aid =~s/\.(jar|pom)$//;
    return $jpp_gid, $jpp_aid;
}

sub raise_PackagingTypeMissingFile {
    my ($pom_path)=@_;
    die "Packaging type is not 'pom' and no artifact path has been provided for pom $pom_path";
}

sub raise_MissingJarFile {
    my ($path)=@_;
    die "Jar seems to be missing in standard directories. Make sure you have installed it ($path)";
}

# """get first xml tag under parent tag within dom"""
sub _get_tag_under_parent {
    my ($dom, $parent, $tag) = @_;
    my $val=$parent->{$tag};
    if (ref $val eq 'ARRAY') {
	$val=$val->[0];
    } elsif (not ref $val) {
	($val)=&Fragment::__strip($val) if $val;
    }
    return $val;
}

# """Returns Fragment class or None if pom file is invalid"""
sub parse_pom {
    my ($pom_file, $jar_file)=@_;
    my $dom = XMLin($pom_file);
    my $project = $dom;
    #print Dumper($project);
    my $proj_packaging = &_get_tag_under_parent($dom, $project, 'packaging');
    # if project packaging is undefined => jar
    # only "pom" packaging type can be without jar_file path otherwise
    # we bail
    if (not $jar_file) {
        if (not $proj_packaging or $proj_packaging ne "pom") {
            &raise_PackagingTypeMissingFile($pom_file);
	}
    }
    my $proj_version = &_get_tag_under_parent($dom, $project, 'version');
    my $proj_gid = &_get_tag_under_parent($dom, $project, 'groupId');
    my $proj_aid = &_get_tag_under_parent($dom, $project, 'artifactId');
    $proj_packaging ||= 'jar';

    return if not $proj_aid;

    my ($jpp_gid, $jpp_aid) = &_get_jpp_from_filename($pom_file, $jar_file);

    if ($proj_version and $proj_gid) {
	return Fragment->new($proj_gid,
         $proj_aid,
         $proj_version,
         $jpp_gid,
         $jpp_aid,
	 $proj_packaging
	    );
    }

    my $parent = &_get_tag_under_parent($dom, $project, 'parent');
    return if not $parent;

    my $pgid = &_get_tag_under_parent($dom, $parent, 'groupId');
    if (not $proj_gid) {
        $proj_gid = $pgid;
    }

    my $pversion = &_get_tag_under_parent($dom, $parent, 'version');
    if (not $proj_version) {
        $proj_version = $pversion
    }

    return Fragment->new($proj_gid,
         $proj_aid,
         $proj_version,
         $jpp_gid,
         $jpp_aid,
	 $proj_packaging
    );
}

package Fragment;
#"""simple structure to hold fragment information"""
sub new {
    my $class=shift;
    my ($gid, $aid, $version, $local_gid,$local_aid,$packaging)=&__strip(@_);
    my $self={};
    $self->{-gid} = $gid;
    $self->{-aid} = $aid;
    $self->{-version} = $version;
    $self->{-local_gid} = $local_gid;
    $self->{-local_aid} = $local_aid;
    $self->{-packaging} = $packaging;
    bless $self, $class;
}

sub __strip {
    my @ret=@_;
    return map {s/^\s*//;s/\s*$//;$_} @ret;
}

__END__

