#!/usr/bin/perl -w
#
# JavaReg -- Query the Debian Java registry.
#
# Copyright (C) 2001 by Ben Burton <benb@acm.org>
#
# This program is free software.  It is distributed under the terms of
# the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any
# later version.
#
# 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.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.

use strict;

use Fcntl ':mode';
use Getopt::Long;

# TODO:
#     Allow successive refinement of queries.

# --- Are we running this as javaversioncomp? ---

if ($0 =~ /javaversioncomp$/) {
    &javaVersionComp();
    exit(0);
}

# --- Global settings. ---

my $registry = "/usr/share/java/registry";
my @runtimeFields = ( "Runtime", "Exec", "Classpath", "Version" );
my @compilerFields = ( "Compiler", "Exec", "Classpath", "Version" );

# --- Parse the command-line options. ---

my $regType = "runtime";
if ($0 =~ /javacreg$/) {
    $regType = "compiler";
}

my $verbose = '';
my $quiet = '';
my @queries = ();
my @outputFields = ();

my %availableOptions = (
    "verbose|v" => \$verbose,
    "quiet|q" => \$quiet,
    "registry|r=s" => \$registry,
    "chase|qc=s" => sub { push @queries, "chase".$_[1]; },
    "versionge|qvg=s" => sub { push @queries, "vge".$_[1]; },
    "versionle|qvl=s" => sub { push @queries, "vle".$_[1]; },
    "highest|qh" => sub { push @queries, "highest"; },
    "lowest|ql" => sub { push @queries, "lowest"; },
    "runtime|or" => sub { push @outputFields, "Runtime"; },
    "compiler|oc" => sub { push @outputFields, "Compiler"; },
    "exec|ox" => sub { push @outputFields, "Exec"; },
    "classpath|op" => sub { push @outputFields, "Classpath"; },
    "version|ov" => sub { push @outputFields, "Version"; },
    "output|of=s" => sub { push @outputFields, $_[1]; }
);
GetOptions(%availableOptions);

if ($verbose and $quiet) {
    $quiet = '';
    &warn("W: Cannot use both --quiet and --verbose.\n");
}

if (! scalar(@queries)) {
    &error("E: No queries were specified.\n");
    exit(1);
}

if (! scalar(@outputFields)) {
    &error("E: No output fields were specified.\n");
    exit(1);
}

# --- Read in the registry. ---

my @runtimes = ();
my @compilers = ();

&readRegistry;

# --- Run the queries. ---

foreach my $query (@queries) {
    my @working;
    if ($regType eq "runtime") {
        push @working, @runtimes;
    } else {
        push @working, @compilers;
    }
    my @newWorking = ();

    # Prune the working list.
    if ($query =~ /chase(.*)/) {
        # Find entries that the given file symlinks to.
        my $link = $1;
        while ($link) {
            foreach my $entry (@working) {
                my $exec = $entry->{"Exec"};
                if ($exec) {
                    if ($link eq $exec) {
                        push @newWorking, $entry;
                    }
                }
            }
            $link = readlink($link);
        }
    } elsif ($query =~ /vge(.*)/) {
        # Find entries with version >= the given version.
        my $goal = $1;
        if (! &isVersion($goal)) {
            &error("E: $goal is not a version number.\n");
            &error("E: Version numbers are sets of digits separated by periods.\n");
            &error("E: Examples include 1.0, 1.3.1, etc.\n");
            exit(1);
        }
        foreach my $entry (@working) {
            my $version = $entry->{"Version"};
            if ($version) {
                if (! &isVersion($version)) {
                    my $entryName = $entry->{"Entry"};
                    &warn("W ($entryName): $version is not a version number.\n");
                } elsif (&compareVersions($version, $goal) >= 0) {
                    push @newWorking, $entry;
                }
            }
        }
    } elsif ($query =~ /vle(.*)/) {
        # Find entries with version <= the given version.
        my $goal = $1;
        if (! &isVersion($goal)) {
            &error("E: $goal is not a version number.\n");
            &error("E: Version numbers are sets of digits separated by periods.\n");
            &error("E: Examples include 1.0, 1.3.1, etc.\n");
            exit(1);
        }
        foreach my $entry (@working) {
            my $version = $entry->{"Version"};
            if ($version) {
                if (! &isVersion($version)) {
                    my $entryName = $entry->{"Entry"};
                    &warn("W ($entryName): $version is not a version number.\n");
                } elsif (&compareVersions($version, $goal) <= 0) {
                    push @newWorking, $entry;
                }
            }
        }
    } elsif ($query eq "highest") {
        # Find the single entry with the highest version.
        my $bestEntry = '';
        my $bestVersion = '';
        foreach my $entry (@working) {
            my $version = $entry->{"Version"};
            if ($version) {
                if (! $bestVersion or
                        &compareVersions($version, $bestVersion) > 0) {
                    $bestVersion = $version;
                    $bestEntry = $entry;
                }
            }
        }
        if ($bestEntry) {
            push @newWorking, $bestEntry;
        }
    } elsif ($query eq "lowest") {
        # Find the single entry with the lowest version.
        my $bestEntry = '';
        my $bestVersion = '';
        foreach my $entry (@working) {
            my $version = $entry->{"Version"};
            if ($version) {
                if (! $bestVersion or
                        &compareVersions($version, $bestVersion) < 0) {
                    $bestVersion = $version;
                    $bestEntry = $entry;
                }
            }
        }
        if ($bestEntry) {
            push @newWorking, $bestEntry;
        }
    }

    # Display the results.
    if (! scalar(@newWorking)) {
        # No matches.
        displayOutput('');
    } else {
        # Just take the first match on the list.
        displayOutput($newWorking[0]);
    }
}

exit(0);

# --- Subroutines. ---

# Run this script as javaversioncomp.
sub javaVersionComp {
    if (scalar(@ARGV) != 2) {
        print STDERR "Usage: $0 <version1> <version2>\n";
        exit(1);
    }
    my $v0 = $ARGV[0];
    my $v1 = $ARGV[1];
    my $bad = 0;
    if (! &isVersion($v0)) {
        &error("E: $v0 is not a version number.\n");
        $bad = 1;
    }
    if (! &isVersion($v1)) {
        &error("E: $v1 is not a version number.\n");
        $bad = 1;
    }
    if ($bad) {
        &error("E: Version numbers are sets of digits separated by periods.\n");
        &error("E: Examples include 1.0, 1.3.1, etc.\n");
        exit(1);
    }
    print &compareVersions($v0, $v1)."\n";
    exit(0);
}

# Determines if the given string is a valid version string.
# Usage: isVersion(versionString)
# Return: true if the string is valid, false otherwise.
sub isVersion {
    return ($_[0] =~ /^\d+(\.\d+)*$/);
}

# Compare two JDK version strings.
# Versions are compared by numerical ordering on their components.
# Components are separated by a period.  For instance, a version string
# '1.3.1' has three components, namely '1', '3' and '1'.
# Each component of a version string must be a number.
#
# Thus, for instance:
#
#   1 < 1.0.1 < 1.1 == 1.01 < 1.3 < 1.10 == 1.010
# 
# Usage: compareVersions(ver0, ver1)
# Return: -1 / 0 / 1 if ver0 < / == / > ver1 respectively.
sub compareVersions {
    my @v0 = split(/\./, $_[0]);
    my @v1 = split(/\./, $_[1]);
    my $len0 = @v0;
    my $len1 = @v1;
    my $pos;

    for ($pos = 0; $pos < $len0 and $pos < $len1; $pos++) {
        if ($v0[$pos] > $v1[$pos]) {
            return 1;
        } elsif ($v0[$pos] < $v1[$pos]) {
            return -1;
        }
    }

    if ($pos < $len0) {
        return 1;
    } elsif ($pos < $len1) {
        return -1;
    }
    return 0;
}

# Display all the requested output fields for the given entry.
# Usage: displayOutput(entryRef)
sub displayOutput {
    foreach my $field (@outputFields) {
        if ($_[0]) {
            print $_[0]->{$field}."\n";
        } else {
            print "none\n";
        }
    }
}

# Read in the registry of JVMs and Java compilers.
# Usage: readRegistry
# Return: 1 on success, 0 on failure.
sub readRegistry {
    # Check that the registry exists and is sane.
    &info("I: Scanning registry $registry ...\n");
    my @regstat = stat($registry);
    if (@regstat) {
        my $mode = $regstat[2];
        if (! ($mode & S_IFDIR)) {
            &error("E: Registry $registry is not a directory.\n");
            return 0;
        }
    } else {
        &error("E: Registry $registry does not exist.\n");
        return 0;
    }

    # Get a list of the files in the registry.
    my @regFiles = glob($registry."/*");
    my $nFiles = @regFiles;
    if ($nFiles == 0) {
        &warn("W: Registry $registry is empty.\n");
        return 1;
    }

    # Read in each registry entry one at a time.
    foreach my $entry (@regFiles) {
        chomp (my $package = `/usr/bin/basename $entry`);
        if (! open(DATA, $entry)) {
            &warn("W ($package): Could not open.\n");
        } else {
            &info("I ($package): Reading ...\n");
            my @lines = <DATA>;
            chomp @lines;
            close(DATA);

            # Parse the lines of the registry entry.
            my %fields = ( "Entry" => $package );
            my $lineNum = 0;
            foreach my $line (@lines) {
                $lineNum++;
                if ($line =~ /^\s*$/) {
                    # Empty line.
                } elsif ($line =~ /^\s*#/) {
                    # Comment.
                } elsif ($line =~ /^\s*(\w+)\s*:\s*(\S*)\s*$/) {
                    # Field.
                    if ($fields{$1}) {
                        &warn("W ($package): $1 defined multiple times.\n");
                    }
                    $fields{$1} = $2;
                } else {
                    &warn("W ($package): Cannot parse line $lineNum.\n");
                }
            }

            # Determine whether what we have is a JVM or a compiler.
            if ($fields{"Runtime"}) {
                if ($fields{"Compiler"}) {
                    &warn("W ($package): Cannot be both runtime and compiler.\n");
                }
                foreach my $field (@runtimeFields) {
                    if (! $fields{$field}) {
                        &warn("W ($package): $field undefined.\n");
                    }
                }
                push @runtimes, { %fields };
            } elsif ($fields{"Compiler"}) {
                foreach my $field (@compilerFields) {
                    if (! $fields{$field}) {
                        &warn("W ($package): $field undefined.\n");
                    }
                }
                push @compilers, { %fields };
            } else {
                &warn("W ($package): Neither a runtime nor a compiler.\n");
            }
        }
    }

    info("I: Registry read.\n");
    return 1;
}

# Write the given message to stderr if verbose mode is on.
#
sub info {
    if ($verbose) {
        print STDERR $_[0];
    }
}

# Write the given message to stderr if quiet mode is off.
#
sub warn {
    if (! $quiet) {
        print STDERR $_[0];
    }
}

# Write the given message to stderr.
#
sub error {
    print STDERR $_[0];
}