#!/v/openpkg/sw/bin/perl
##
##  Copyright (c) 2000-2006 OpenPKG Foundation e.V. <http://openpkg.net/>
##  Copyright (c) 2000-2006 Ralf S. Engelschall <http://engelschall.com/>
##
##  Permission to use, copy, modify, and distribute this software for
##  any purpose with or without fee is hereby granted, provided that
##  the above copyright notice and this permission notice appear in all
##  copies.
##
##  THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED 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 AUTHORS AND COPYRIGHT HOLDERS AND THEIR
##  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.
##
##  browser.cgi -- OpenPKG Tool Chain, Package Browser, CGI User Interface
##

#   requirements
require 5;
use DBI;
use DBD::SQLite;
use DBIx::Simple;
use CGI;
use CGI::Cookie;
use CGI::GuruMeditation (-name => "OpenPKG browser", -debug => 1);
use String::Divert;
use IO::File;
use Date::Format;
use HTML::Entities;
use URI::Escape;
use strict;
use warnings;

#   program information
my $progname = "browser";
my $progvers = "0.9.0";
my $database = "browser.db";

#   establish CGI query object
my $cgi = new CGI;

#   establish Database query object
my $db = DBIx::Simple->connect(
    "dbi:SQLite:dbname=$database", "", "",
    { RaiseError => 0, AutoCommit => 0 }
) or die "unable to open database";

#   establish HTML output object
my $html = new String::Divert;
$html->folder('{#%s#}', '\{#([a-zA-Z_][a-zA-Z0-9_-]*)#\}');
$html->overload(1);
my $io = new IO::File "<browser.cgi.page.html" or die;
my $canvas = ''; $canvas .= $_ while (<$io>);
$io->close();
$canvas =~ s/<!-- BROWSER HEAD -->/$html->folder("head")/sie;
$canvas =~ s/<!-- BROWSER SIDE -->/$html->folder("side")/sie;
$canvas =~ s/<!-- BROWSER BODY -->/$html->folder("body")/sie;
$html->append($canvas);

#   provide inner HTML canvas
$html->divert("head");
$html .= "<link rel=\"stylesheet\" type=\"text/css\" href=\"browser.css\"/>\n";
$html->undivert();
$html->divert("body");
$html .= "<div class=\"browser\">\n";
$html .= "  "; $html->fold();
$html .= "</div>\n";
$html->divert();

#   determine OpenPKG Registry login
my $cookies = fetch CGI::Cookie;
my $registry_login = (exists $cookies->{"registry_login"} ? $cookies->{"registry_login"}->value || "" : "");

#   provide a general hint on the sidebar
$html->divert("side");
$html .= "<b>Hint:</b> The information provided on these pages are directly derived from the XML/RDF indices at the OpenPKG FTP service.";
$html .= "The information is updated twice per day.";
$html .= "<p/>";
$html->undivert();

#   helper function for translating a package class into an icon
sub class2icon {
    my ($class) = @_;
    my $icon = {
        CORE => '&hearts;',
        BASE => '&radic;',
        PLUS => '&otimes;',
        EVAL => '&oslash;',
        JUNK => '&times;',
    }->{$class};
    return "<span class=\"$class\">$icon</span>";
}

#   determine runtime parameters
my $submit  = $cgi->param("submit")  || "";
my $group   = $cgi->param("group")   || "/";
my $package = $cgi->param("package") || "";

#   escaping helper
sub escape {
    my ($fmt, $str) = @_;
    if ($fmt eq 'url') {
        $str = uri_escape($str);
    }
    elsif ($fmt eq 'html') {
        $str = encode_entities($str);
    }
    elsif ($fmt eq 'sql') {
        $str =~ s/['']/''/sg;
    }
    return $str;
}

#   dispatch commands
if ($submit) {
    ##
    ##  SEARCHING
    ##
    my $form = $cgi->param("form") || die;
    if ($form eq 'search-keyword') {
        my @keywords = split(/\s+/, $cgi->param("search") || "");
        my @rec;
        if (@keywords > 0) {
            my $query = '';
            foreach my $keyword (@keywords) {
                my $negate = "";
                if ($keyword =~ m/^([+-])(.+)$/) {
                    $negate = ($1 eq '-' ? " NOT " : "");
                    $keyword = $2;
                }
                $keyword = escape("sql", uc($keyword));
                $query .= " AND " if ($query);
                $query .= $negate;
                $query .= "(upper(package) = '$keyword'";
                $query .= " OR upper(url) LIKE '\%$keyword\%'";
                $query .= " OR upper(vendor) LIKE '\%$keyword\%'";
                $query .= " OR upper(xgroup) LIKE '\%$keyword\%'";
                $query .= " OR upper(summary) LIKE '\%$keyword\%'";
                $query .= " OR upper(description) LIKE '\%$keyword\%')";
            }
            @rec = $db->query(qq{
                SELECT   package, summary
                FROM     package
                WHERE    $query
            })->hashes();
        }
        else {
            @rec = $db->query(qq{
                SELECT   package, summary
                FROM     package
            })->hashes();
        }
        $html .= "<table class=\"search\">\n";
        $html .= "  <tr>\n";
        $html .= "    <td>"; $html->fold("search-keyword1"); $html .= "</td>\n";
        $html .= "    <td>"; $html->fold("search-package1"); $html .= "</td>\n";
        $html .= "  </tr>\n";
        $html .= "  <tr>\n";
        $html .= "    <td>"; $html->fold("search-keyword2"); $html .= "</td>\n";
        $html .= "    <td>"; $html->fold("search-package2"); $html .= "</td>\n";
        $html .= "  </tr>\n";
        $html .= "</table>\n";
        $html >> "search-keyword1";
        $html << 1;
        $html >> "search-keyword2";
        $html .= "<p/><b>Multi Keyword Exact Search:</b><br/>";
        $html .= $cgi->start_form(-method => "GET", -action => $cgi->url(-relative => 1));
        $html .= "<div>";
        $html .= $cgi->textfield(-name => "search", -value => "web server -apache");
        $html .= $cgi->hidden(-name => "form", -value => "search-keyword");
        $html .= $cgi->submit(-name => "submit", -value => "Search");
        $html .= "</div>";
        $html .= $cgi->end_form();
        $html << 1;
        $html >> "search-package1";
        $html << 1;
        $html >> "search-package2";
        $html .= "<p/><b>Package Name Fuzzy Search:</b><br/>";
        $html .= $cgi->start_form(-method => "GET", -action => $cgi->url(-relative => 1));
        $html .= "<div>";
        $html .= $cgi->textfield(-name => "search", -value => "apache");
        $html .= $cgi->hidden(-name => "form", -value => "search-package");
        $html .= $cgi->submit(-name => "submit", -value => "Show");
        $html .= "</div>";
        $html .= $cgi->end_form();
        $html << 1;
        $html .= "<hr>\n";
        $html .= "<h2>Previous Search Result</h2>\n";
        if (@rec == 0) {
            $html .= "No packages were found.<p/>";
        }
        else {
            $html .= "<table style=\"border-collapse: collapse;\">\n";
            foreach my $rec (sort { $a->{'package'} cmp $b->{'package'} } @rec) {
                $html .= sprintf("<tr><td><a class=\"package\" href=\"%s?package=%s\">%s</a>&nbsp;&nbsp;</td><td>%s</td></tr>\n",
                    $cgi->url(-relative), $rec->{'package'}, $rec->{'package'}, escape("html", $rec->{'summary'}));
            }
            $html .= "</table>\n";
        }
    }
    elsif ($form eq 'search-package') {
        my $package = $cgi->param("search") || die;
        $package =~ s/[^a-zA-Z0-9-]//sg;
        my $rec = $db->query(q{
            SELECT   package
            FROM     package
            WHERE    upper(package) = ?;
        }, uc($package))->hash();
        if (defined($rec)) {
            print $cgi->redirect(
                -uri => $cgi->url(-absolute => 1)."?package=$package"
            );
            exit(0);
        }
        else {
            $html .= "<table class=\"search\">\n";
            $html .= "  <tr>\n";
            $html .= "    <td>"; $html->fold("search-keyword1"); $html .= "</td>\n";
            $html .= "    <td>"; $html->fold("search-package1"); $html .= "</td>\n";
            $html .= "  </tr>\n";
            $html .= "  <tr>\n";
            $html .= "    <td>"; $html->fold("search-keyword2"); $html .= "</td>\n";
            $html .= "    <td>"; $html->fold("search-package2"); $html .= "</td>\n";
            $html .= "  </tr>\n";
            $html .= "</table>\n";
            $html >> "search-keyword1";
            $html << 1;
            $html >> "search-keyword2";
            $html .= "<p/><b>Multi Keyword Exact Search:</b><br/>";
            $html .= $cgi->start_form(-method => "GET", -action => $cgi->url(-relative => 1));
            $html .= "<div>";
            $html .= $cgi->textfield(-name => "search", -value => "web server -apache");
            $html .= $cgi->hidden(-name => "form", -value => "search-keyword");
            $html .= $cgi->submit(-name => "submit", -value => "Search");
            $html .= "</div>";
            $html .= $cgi->end_form();
            $html << 1;
            $html >> "search-package1";
            $html << 1;
            $html >> "search-package2";
            $html .= "<p/><b>Package Name Fuzzy Search:</b><br/>";
            $html .= $cgi->start_form(-method => "GET", -action => $cgi->url(-relative => 1));
            $html .= "<div>";
            $html .= $cgi->textfield(-name => "search", -value => "apache");
            $html .= $cgi->hidden(-name => "form", -value => "search-package");
            $html .= $cgi->submit(-name => "submit", -value => "Show");
            $html .= "</div>";
            $html .= $cgi->end_form();
            $html << 1;
            $html .= "<hr>\n";
            $html .= "<h2>Previous Search Result</h2>\n";
            $html .= "OpenPKG package \"$package\" not found!<p/>";
            my $query = sprintf("upper(package) LIKE '\%\%%s\%\%'", escape("sql", uc($package)));
            for (my $i = 0; $i < length($package)-1; $i++) {
                my $p = uc($package);
                $p =~ s/^(.{$i})(.)(.)(.*)$/$1$3$2$4/s;
                $p = escape("sql", $p);
                $query .= " OR upper(package) = '$p'";
            }
            my @rec = $db->query(qq{
                SELECT   package, summary
                FROM     package
                WHERE    $query
            })->hashes();
            if (@rec == 0) {
                my $query = 'true';
                for (my $i = 0; $i <= length($package)-4; $i++) {
                    $query .= sprintf(" OR upper(package) LIKE '%s\%\%'",
                        escape("sql", uc(substr($package, 0, length($package)-($i+1)))));
                    $query .= sprintf(" OR upper(package) LIKE '\%\%%s'",
                        escape("sql", uc(substr($package, length($package)-($i+1)))));
                }
                @rec = $db->query(qq{
                    SELECT   package, summary
                    FROM     package
                    WHERE    $query
                })->hashes();
            }
            if (@rec == 0) {
                $html .= "No similar packages were found, too.<p/>";
            }
            else {
                $html .= "The following similar packages were found:<p/>";
                $html .= "<table style=\"border-collapse: collapse;\">\n";
                foreach my $rec (sort { $a->{'package'} cmp $b->{'package'} } @rec) {
                    $html .= sprintf("<tr><td><a class=\"package\" href=\"%s?package=%s\">%s</a>&nbsp;&nbsp;</td><td>%s</td></tr>\n",
                        $cgi->url(-relative), $rec->{'package'}, $rec->{'package'}, escape("html", $rec->{'summary'}));
                }
                $html .= "</table>\n";
            }
        }
    }
}
elsif ($group  and not $package) {
    ##
    ##  BROWSE GROUPS
    ##

    #   query tree hierarchy
    my $tree = { "" => { -groups => {}, -packages => [] }};
    my $pkg2class = {};
    my $pkg2summary = {};
    my $n = 0;
    foreach my $rec ($db->query(q{
        SELECT   xgroup, package, class, summary
        FROM     package;
    })->hashes()) {
        my $group = $rec->{'xgroup'};
        my $package = $rec->{'package'};
        $tree->{$group} = { -groups => {}, -packages => [] }
           if (not exists $tree->{$group});
        push(@{$tree->{$group}->{-packages}}, $package);
        while (my ($prefix, $name) = ($group =~ m/^(|.+\/)([^\/]+)$/s)) {
            ($group = $prefix) =~ s/\/$//s;
            $tree->{$group} = { -groups => {}, -packages => [] }
               if (not exists $tree->{$group});
            $tree->{$group}->{-groups}->{$name} = 1;
        }
        $pkg2class->{$package} = $rec->{"class"};
        $pkg2summary->{$package} = $rec->{"summary"};
        $n++;
    }

    $html .= "<table class=\"search\">\n";
    $html .= "  <tr>\n";
    $html .= "    <td>"; $html->fold("search-keyword1"); $html .= "</td>\n";
    $html .= "    <td>"; $html->fold("search-package1"); $html .= "</td>\n";
    $html .= "  </tr>\n";
    $html .= "  <tr>\n";
    $html .= "    <td>"; $html->fold("search-keyword2"); $html .= "</td>\n";
    $html .= "    <td>"; $html->fold("search-package2"); $html .= "</td>\n";
    $html .= "  </tr>\n";
    $html .= "</table>\n";
    $html >> "search-keyword1";
    $html << 1;
    $html >> "search-keyword2";
    $html .= "<p/><b>Multi Keyword Exact Search:</b><br/>";
    $html .= $cgi->start_form(-method => "GET", -action => $cgi->url(-relative => 1));
    $html .= "<div>";
    $html .= $cgi->textfield(-name => "search", -value => "web server -apache");
    $html .= $cgi->hidden(-name => "form", -value => "search-keyword");
    $html .= $cgi->submit(-name => "submit", -value => "Search");
    $html .= "</div>";
    $html .= $cgi->end_form();
    $html << 1;
    $html >> "search-package1";
    $html << 1;
    $html >> "search-package2";
    $html .= "<p/><b>Package Name Fuzzy Search:</b><br/>";
    $html .= $cgi->start_form(-method => "GET", -action => $cgi->url(-relative => 1));
    $html .= "<div>";
    $html .= $cgi->textfield(-name => "search", -value => "apache");
    $html .= $cgi->hidden(-name => "form", -value => "search-package");
    $html .= $cgi->submit(-name => "submit", -value => "Show");
    $html .= "</div>";
    $html .= $cgi->end_form();
    $html << 1;
    $html .= "<hr>\n";

    $html .= "<h2>Package Browsing</h2>\n";
    $html .= "Browse for currently <b>$n</b> packages in OpenPKG-CURRENT by their groups. ";
    $html .= "Packages are annotated with their short summary and quality class information (legend: ";
    $html .= class2icon("CORE") . " CORE, ";
    $html .= class2icon("BASE") . " BASE, ";
    $html .= class2icon("PLUS") . " PLUS, ";
    $html .= class2icon("EVAL") . " EVAL, ";
    $html .= class2icon("JUNK") . " JUNK";
    $html .= ").";
    $html .= "<p/>\n";

    $group =~ s/^\///s;
    my $parent = $group;
    if ($parent ne '') {
        $parent =~ s/^(|.*\/)[^\/]+$/$1/s;
        $parent =~ s/\/$//s;
        my $url = $cgi->url(-relative => 1);
        $url .= "?group=" . escape("url", $parent) if ($parent ne '');
        $url .= "." if ($url eq '');
        $html .= "<a href=\"$url\">&larr; back</a>";
    }
    $html .= "<p/>\n";
    $html .= "<b>$group/</b><br/>\n" if ($group ne '');
    $html .= "<table class=\"list\">\n";
    $html .= "  <tr>\n";
    $html .= "    <td>";
    $html .= "    <ul class=\"compact\">";
    my $path = $group;
    my $folder = $tree->{$path} or die;
    my $n = 3;
    my $k = scalar(keys %{$folder->{-groups}}) + scalar(@{$folder->{-packages}});
    my $i = 0;
    my $j = (int($k/$n)*$n == $k ? ($k/$n) : int($k/$n)+1);
    foreach my $group (sort keys %{$folder->{-groups}}) {
        if ($i > 0 and ($i % $j) == 0) {
            $html .= "</ul>";
            $html .= "</td>";
            $html .= "<td>";
            $html .= "<ul class=\"compact\">";
        }
        my $group_path = ($path ne '' ? $path . "/" . $group : $group);
        my $num = scalar(keys %{$tree->{$group_path}->{-groups}}) + scalar(@{$tree->{$group_path}->{-packages}});
        $html .= sprintf("<li><a class=\"group\" href=\"%s?group=%s\">%s/</a>&nbsp;<span class=\"number\">(%d)</span></li>\n",
            $cgi->url(-relative), escape("url", $group_path), escape("html", $group), $num);
        $i++;
    }
    foreach my $package (sort @{$folder->{-packages}}) {
        if ($i > 0 and ($i % $j) == 0) {
            $html .= "</ul>";
            $html .= "</td>";
            $html .= "<td>";
            $html .= "<ul class=\"compact\">";
        }
        my $icon = class2icon($pkg2class->{$package});
        my $summary = $pkg2summary->{$package};
        $html .= sprintf("<li><a class=\"package\" href=\"%s?package=%s\">%s&nbsp;&nbsp;$icon</a><br/><div class=\"summary\">$summary</div></li>\n",
            $cgi->url(-relative), escape("url", $package), escape("html", $package));
        $i++;
    }
    $html .= "    </ul>";
    $html .= "    </td>";
    $html .= "  </tr>\n";
    $html .= "</table>\n";

    
}
elsif ($package) {
    ##
    ##  SHOW PACKAGE
    ##

    my $package = $cgi->param("package") || die;
    $package =~ s/[^a-zA-Z0-9-]//sg;
    my $pkg = $db->query(q{
        SELECT   *
        FROM     package
        WHERE    package = ?;
    }, $package)->hash();
    if (not defined($pkg)) {
        print $cgi->redirect(-uri => $cgi->url(-absolute => 1));
        exit(0);
    }

    $html .= "<table class=\"search\">\n";
    $html .= "  <tr>\n";
    $html .= "    <td>"; $html->fold("search-keyword1"); $html .= "</td>\n";
    $html .= "    <td>"; $html->fold("search-package1"); $html .= "</td>\n";
    $html .= "  </tr>\n";
    $html .= "  <tr>\n";
    $html .= "    <td>"; $html->fold("search-keyword2"); $html .= "</td>\n";
    $html .= "    <td>"; $html->fold("search-package2"); $html .= "</td>\n";
    $html .= "  </tr>\n";
    $html .= "</table>\n";
    $html >> "search-keyword1";
    $html << 1;
    $html >> "search-keyword2";
    $html .= "<p/><b>Multi Keyword Exact Search:</b><br/>";
    $html .= $cgi->start_form(-method => "GET", -action => $cgi->url(-relative => 1));
    $html .= "<div>";
    $html .= $cgi->textfield(-name => "search", -value => "web server -apache");
    $html .= $cgi->hidden(-name => "form", -value => "search-keyword");
    $html .= $cgi->submit(-name => "submit", -value => "Search");
    $html .= "</div>";
    $html .= $cgi->end_form();
    $html << 1;
    $html >> "search-package1";
    $html << 1;
    $html >> "search-package2";
    $html .= "<p/><b>Package Name Fuzzy Search:</b><br/>";
    $html .= $cgi->start_form(-method => "GET", -action => $cgi->url(-relative => 1));
    $html .= "<div>";
    $html .= $cgi->textfield(-name => "search", -value => "apache");
    $html .= $cgi->hidden(-name => "form", -value => "search-package");
    $html .= $cgi->submit(-name => "submit", -value => "Show");
    $html .= "</div>";
    $html .= $cgi->end_form();
    $html << 1;
    $html .= "<hr>\n";
    $html .= "<h2>Search Result Package Details</h2>\n";
    $html .= "The following summary information is known about the \"$package\" package.";
    $html .= "<p/>\n";
    $html .= "<table class=\"package\">\n";
    my $i = 0;
    foreach my $header (qw(
        package:Package-Name
        summary:Summary
        description:Description
        url:Homepage-URL
        vendor:Vendor
        packager:Packager
        distribution:Distribution
        class:Class
        xgroup:Group
        license:Distribution-License
        version:Vendor-Software-Version 
        release:OpenPKG-Package-Release
    )) {
        my ($id, $name) = $header =~ m/^(\S+):(.*)$/;
        $name =~ s/-/ /sg;
        my $value = $pkg->{$id};
        $value =~ s/^((?:ftp|https?):\/\/.+)$/<a href="$1">$1<\/a>/s;
        $value .= "&nbsp;&nbsp;" . class2icon($value) if ($id eq 'class');
        $value = "<a href=\"".$cgi->url(-relative => 1)."?group=".$value."\">$value</a>" if ($id eq 'xgroup');
        if ($id eq 'description') {
            $value =~ s/^#.+$//mg;
            $value =~ s/\%\{.+?\}//sg;
        }
        $html .= "<tr class=\"a$i\">\n";
        $html .= "  <td class=\"header\">$name</td>\n";
        $html .= "  <td class=\"value\">$value</td>\n";
        $html .= "</tr>\n";
        $i = ($i + 1) % 2;
    }

    my @provide = $db->query(q{
        SELECT   *
        FROM     package_provide
        WHERE    package = ?;
    }, $package)->hashes();
    my $list = "";
    foreach my $provide (@provide) {
        if ($provide->{"name"} =~ m/^${package}::(.+)$/) {
            $list .= ", " if ($list ne '');
            $list .= sprintf("%s", encode_entities($1));
        }
    }
    $list = "none" if ($list eq '');
    $html .= "<tr class=\"a".($i++ % 2)."\">\n";
    $html .= "  <td class=\"header\">Build-Time Options</td>\n";
    $html .= "  <td class=\"value\">$list</td>\n";
    $html .= "</tr>\n";

    sub render_dep {
        my ($list, $dep) = @_;
        if ($list ne '') {
            $list =~ s/\s+$//s;
            $list .= ", "
        }
        if ($dep->{"name"} =~ m/^(.+)(::.+)/) {
            my $url = $cgi->url(-relative => 1) ."?package=". encode_entities($1);
            $list .= sprintf("<a href=\"$url\">%s</a>%s %s", encode_entities($1), encode_entities($2), encode_entities($dep->{'value'}));
        }
        elsif ($dep->{"name"} =~ m/^[a-z][a-z0-9-]*$/) {
            my $url = $cgi->url(-relative => 1) ."?package=". encode_entities($dep->{'name'});
            $list .= sprintf("<a href=\"$url\">%s</a> %s", encode_entities($dep->{'name'}), $dep->{'value'} eq '= *' ? "" : encode_entities($dep->{'value'}));
        }
        else {
            $list .= sprintf("%s %s", encode_entities($dep->{'name'}), $dep->{'value'} eq '= *' ? "" : encode_entities($dep->{'value'}));
        }
        if ($dep->{"condition"}) {
            $list =~ s/\s+$//s;
            $list .= sprintf("&deg;") 
        }
        return $list;
    }
    my @dep = $db->query(q{
        SELECT   *
        FROM     package_prereq
        WHERE    package = ?;
    }, $package)->hashes();
    my $list = "";
    foreach my $dep (sort grep { $_->{"class"} eq 'B' } @dep) {
        $list = render_dep($list, $dep);
    }
    $list = "none" if ($list eq '');
    $html .= "<tr class=\"a".($i++ % 2)."\">\n";
    $html .= "  <td class=\"header\">Build-Time Dependencies</td>\n";
    $html .= "  <td class=\"value\">$list</td>\n";
    $html .= "</tr>\n";
    my $list = "";
    foreach my $dep (sort grep { $_->{"class"} eq 'I' } @dep) {
        $list = render_dep($list, $dep);
    }
    $list = "none" if ($list eq '');
    $html .= "<tr class=\"a".($i++ % 2)."\">\n";
    $html .= "  <td class=\"header\">Install-Time Dependencies</td>\n";
    $html .= "  <td class=\"value\">$list</td>\n";
    $html .= "</tr>\n";

    my @SA = $db->query(q{
        SELECT   *
        FROM     security_advisory
        WHERE    package = ?;
    }, $package)->hashes();
    my $list = "";
    my %sah = (); map { $sah{$_->{"advisory"}} = 1 } @SA;
    foreach my $sa (reverse sort keys %sah) {
        $list .= ", " if ($list ne '');
        $list .= sprintf("<a href=\"http://www.openpkg.com/security/advisories/OpenPKG-SA-%s.html\">%s</a>", $sa, $sa);
    }
    $list = "none" if ($list eq '');
    $html .= "<tr class=\"a".($i++ % 2)."\">\n";
    $html .= "  <td class=\"header\">Security Advisories</td>\n";
    $html .= "  <td class=\"value\">$list</td>\n";
    $html .= "</tr>\n";

    $html .= "</table>\n";
    
    $html .= "<h2>Package Sources</h2>\n";
    $html .= "The following are deep links into the <a href=\"http://cvs.openpkg.org\">OpenPKG CVS Repository</a> to all " .
             "<a href=\"http://cvs.openpkg.org/dir?d=openpkg-src/$package&sc=1\">packaging source files</a> " .
             "which are related to the \"$package\" package.";
    $html .= "<p/>\n";
    $html .= "</ul>\n";
    my @src = $db->query(q{
        SELECT   url_source
        FROM     package_source
        WHERE    package = ?;
    }, $package)->flat();
    $html .= "<ul class=\"compact\">\n";
    foreach my $src ("$package.spec", sort grep { ! /^(?:ftp|https?):\/\// } @src) {
        $html .= sprintf("<li><a href=\"http://cvs.openpkg.org/fileview?f=openpkg-src/%s/%s\">%s</a>", $package, $src, $src);
        $html .= sprintf("&nbsp;<span class=\"history\">(<a href=\"http://cvs.openpkg.org/rlog?f=openpkg-src/%s/%s\">history</a>)</span></br>", $package, $src, $src);
        my $hint = "unknown source file";
        $hint = "OpenPKG RPM package specification" if ($src =~ m/\.spec$/);
        $hint = "OpenPKG patch file" if ($src =~ m/\.patch(?:\.[a-z0-9]+)?$/);
        $hint = "OpenPKG run-command script" if ($src =~ m/^rc\.$package$/);
        $hint = "OSSP fsl configuration" if ($src =~ m/^fsl\.$package$/);
        $hint = "default configuration file" if ($src =~ m/\.(?:conf|cfg|cf|ini)$/);
        $hint = "shell script" if ($src =~ m/\.sh$/);
        $hint = "Perl script" if ($src =~ m/\.pl$/);
        $html .= sprintf("<div class=\"annotation\">%s</div></li>\n", $hint);
    }
    $html .= "</ul>\n";
    $html->divert("side");
    $html .= "<div class=\"history_hint\"><b>Tip:</b> To get a detailed overview on how the " .
             "\"$package\" package evolved over time, just visit the ";
    $html .= sprintf("<a href=\"http://cvs.openpkg.org/rlog?f=openpkg-src/%s/%s.spec\">%s</a>", $package, $package, "Package History");
    $html .= " timeline.</div>";
    $html->undivert();

    $html .= "<h2>Package Distribution</h2>\n";
    $html .= "The \"$package\" package is part of the following particular OpenPKG distributions.";
    $html .= "<p/>\n";
    my $rpm = {};
    foreach my $rec ($db->query(q{
        SELECT   *
        FROM     package_distribution
        JOIN     distribution
        ON       package_distribution.distribution = distribution.distribution
        WHERE    package_distribution.package = ?;
    }, $package)->hashes()) {
        $rpm->{$rec->{'distribution'}} = { -url => '', -rpm => [] }
            if (not exists $rpm->{$rec->{'distribution'}});
        $rpm->{$rec->{'distribution'}}->{-url} = $rec->{'url_dir'};
        push(@{$rpm->{$rec->{'distribution'}}->{-rpm}}, $rec->{'url_rpm'});
    }
    sub sort_by_tag {
        my ($A, $B) = ($a, $b);
        $A =~ s/^OpenPKG-//s;
        $B =~ s/^OpenPKG-//s;
        $A =~ s/-(STABLE|RELEASE)//s;
        $B =~ s/-(STABLE|RELEASE)//s;
        $A =~ s/CURRENT/99999999/s;
        $B =~ s/CURRENT/99999999/s;
        $A =~ s/-/\./s;
        $B =~ s/-/\./s;
        $A =~ s/^(\d)$/$1.99999999/s;
        $B =~ s/^(\d)$/$1.99999999/s;
        return sort_by_release_internal($A, $B);
    }
    sub sort_by_release {
        my ($a, $b) = @_;
        return sort_by_release_internal($a, $b);
    }
    sub sort_by_release_internal {
        my ($a, $b) = @_;
        my @a = split(/\./, $a);
        my @b = split(/\./, $b);
        my ($ax, $bx, $c);
        while (@a && @b) {
            if ($a[0] =~ /^\d+$/ && $b[0] =~ /^\d+$/) {
                $c = $a[0] <=> $b[0];
            } elsif ((($a, $ax) = $a[0] =~ /^(\d+)(.*)$/) &&
                     (($b, $bx) = $b[0] =~ /^(\d+)(.*)$/)) {
                $c = $a <=> $b;
                $c = $ax cmp $bx unless ($c);
            } else {
                $c = $a[0] cmp $b[0];
            }
            return $c if ($c != 0);
            shift(@a);
            shift(@b);
        }
        $c = (scalar(@a) <=> scalar(@b));
        return $c;
    }
    $html .= "<table class=\"download\">\n";
    my $i = 0;

    (my $login = $registry_login) =~ s/\@/\%40/sg;
    my $url_re  = qr/^ftp:\/\/ftp\.openpkg\.org/;
    my $url_str = "ftp://${login}:xxx\@ftp.openpkg.org";
    foreach my $distribution (reverse sort sort_by_tag keys %{$rpm}) {
        my @rpms = reverse sort {
            my ($A, $B) = ($a, $b);
            $A =~ s/^.+?-[^-]+-([^-]+)\.(?:src|[^-]+-[^-]+-[^-]+)\.rpm$/$1/s;
            $B =~ s/^.+?-[^-]+-([^-]+)\.(?:src|[^-]+-[^-]+-[^-]+)\.rpm$/$1/s;
            sort_by_release_internal($A, $B);
        } @{$rpm->{$distribution}->{-rpm}};
        $html .= "<tr class=\"a$i\">\n";
        $html .= "  <td class=\"dist\">\n";
        $html .= sprintf("<a href=\"%s\">%s</a><br/>", $rpm->{$distribution}->{-url}, $distribution);
        $html .= "  </td>\n";
        $html .= "  <td class=\"rpm\">\n";
        foreach my $r (@rpms) {
            my ($name, $version, $release) = ($r =~ m/^(.+?)-([^-]+)-([^-]+)\.(?:src|[^-]+-[^-]+-[^-]+)\.rpm$/s);
            my $url = $rpm->{$distribution}->{-url} . $r;
            $url =~ s/$url_re/$url_str/s if ($registry_login);
            my @sa = grep { $_->{'status'} eq 'affected' and $_->{'version'} eq $version and $_->{'release'} eq $release } @SA;
            my $class = (@sa > 0 ? "affected" : "ok");
            $html .= sprintf("<a class=\"%s\" href=\"%s\">%s-%s</a>", $class, $url, $version, $release);
            foreach my $sa (@sa) {
                $html .= sprintf("&nbsp;&rarr;&nbsp;<a class=\"sa\" href=\"http://www.openpkg.com/security/advisories/OpenPKG-SA-%s.html\">SA</a>",
                    $sa->{'advisory'},
                );
            }
            $html .= "&nbsp; ";
        }
        $html .= "  </td>\n";
        $html .= "</tr>\n";
        $i = ($i + 1) % 2;
    }
    $html .= "</table>\n";
    if ($registry_login eq '') {
        $html->divert("side");
        $html .= "<p/><div class=\"notice\"><b>Notice:</b> Most of the direct download URLs to FTP service resources provided under \"Package Distribution\" will NOT work as expected as you have still not " .
                 "at least once provided your <a href=\"/download/registration/\">registered</a> Email address on the <a href=\"/download/\">Download</a> page. Without " .
                 "proper identification the OpenPKG FTP service resources are still <a href=\"/download/policy.php\">restricted</a>.</div>";
        $html->undivert();
    }
}

#   send output 
$html->overload(0);
$html->undivert(0);
$html = $html->string();
print $cgi->header(
    -type           => "text/html",
    -Content_length => length($html),
    -X_User_Agent   => sprintf("%s/%s", $progname, $progvers),
    -Cache_Control  => "max-age=0",
    -expires        => "+0s",
) . $html;

#   close database
$db->commit();
$db->disconnect();
undef $db;

#   die gracefully
exit(0);