#!/usr/bin/env perl

#
# Reads list of DOAP files from files.xml and list of cached entries from doap/files.list.
# For each URL, uses the cache to determine the local name and downloads the file if it has
# been modified since the current date of the local copy.
#
# The cache is rewritten.
#
# Any DOAP files which are not in the cache are removed.
#
# Various XSL stylesheets are then run against the cache file.
#

use strict;

use Cwd qw( realpath );
use FindBin;
use File::Basename;
use File::Copy;
use File::Spec::Functions;
use Data::Dumper;
use POSIX qw(strftime);
use Net::SMTP;
use LWP::UserAgent;
use HTTP::Request;

BEGIN {
    # Add the standard places we expect to find the support libs. 
    # We add these regardless as having them on the search path won't
    # do any harm
    # and new directories are pushed on the front, so if there is an environment
    # setting for us to use it'll end up prior to our guesses.
    # NB at present we don't have any *standard* locations,
    #    so this should be adjusted when we do have!
    my @stdlibdirs = ( '../../support', 
                       '../../infra-tools/support', 
                       '../../tools/support',
                       '/usr/local/asf_support');
    foreach my $d (@stdlibdirs) {
        my $dir = $d;
        # Use eval to avoid run-time error (No such file or directory) on Windows 
        eval {$dir = realpath(realpath(catdir(dirname($0), $d)))} if $d =~ /^\./;
        next unless -d $dir;
        $dir = catdir(realpath($dir), 'perl');
        next unless -d $dir;
        unshift(@INC, $dir);
    }
    if ($ENV{ASF_SITE_LIBS}) {
        unshift(@INC, catdir($ENV{ASF_SITE_LIBS}, 'perl')) if 
                $ENV{ASF_SITE_LIBS};
    }
    unshift(@INC, realpath($FindBin::Bin));

    my @mods = ( 'xsltProc', 'File::Slurp', 'Date::Manip', 'XML::dspp' );

    foreach my $m (@mods) {
        if (! eval("require $m")) {
        	# Copy to STDOUT so it appears in the log
            print "Unable to find or use module '$m'\nError: $!\n";
            print STDERR <<EOT;

Unable to find or use module '$m'
Error: $!

Have you got the ASF_SITE_LIBS environmental variable set?
Does it point at the correct directory?
Are your check outs up to date?

EOT
            print STDERR "INC paths:\n";
            foreach my $p (@INC) { print STDERR "\t$p\n"; }
        	# Copy to STDOUT so it appears in the log
            print "INC paths:\n";
            foreach my $p (@INC) { print "\t$p\n"; }
            die "Not all required modules available";
        }
    }
}

# These modules are in the support/perl repository.
use xsltProc;
use File::Slurp;
use Date::Manip;
use XML::dspp;
#use PAO;

my $baseDir = realpath(catdir($FindBin::Bin, '..'));

my $getfiles = 1;           # do we need to fetch latest doap files?
my $exitVal = 1;            # the value we exit with, 0 for success
my $DEBUG = 0;              # are we in debug mode? NOTUSED
my $reportMsg;              # NOTUSED
my $forceUpdate = 0;        # force an update of files NOTUSED
my $doapErrors = '';
my $urlErrors = '';
my $tmpDir = catdir($baseDir, 'work');
my $doapDir = catdir($baseDir, 'doap');

my (%feeds, %id, %fileName, %projectName);
my @doaps;    # array of files we have read ok
my $fileList = catfile($baseDir, "doap/files.list");
my $tagDir = catdir($baseDir, 'html', 'tags'); # NOTUSED

my $doapList = catfile($baseDir, 'files.xml');

# process command line arguments
for my $i (0 .. $#ARGV) {
    my $arg = $ARGV[$i];
    next unless $arg =~ /^--/;
    $getfiles = 0 if ($arg =~ /no-fetch/ ||
                      $arg =~ /nofetch/);
    $DEBUG = 1 if ($arg =~ /debug/);
    $forceUpdate =1 if $arg =~ /force/;
    $tagDir = $ARGV[$i + 1] if $arg =~ /tagdir/;
    $doapList = $ARGV[$i + 1] if $arg =~ /doapList/;
}

cleanGeneratedFiles();
readDOAPLocations(); # Reads files.xml into %feeds
readDOAPList(); # read $fileList (doap/files.list) into %id, %fileName, %projectName

my $ua;

if ($getfiles) {
    $ua = LWP::UserAgent->new;
    $ua->agent('projects 1.0');
    # $ua->show_progress(1); # Add some trace for when requests fail

    updateDOAPFiles(); # reads the DOAP in %feeds into a temp file and updates %feeds
    print "Error Report\n------------\n$urlErrors\n" if $urlErrors;
    processDOAPFiles();# Rename downloaded files according to project name
    print "DOAP Errors\n-----------\n$doapErrors\n" if $doapErrors;
    writeDOAPList(); # write $fileList from %feeeds, %id, %fileName, %projectName
    my @tm = localtime();
    # $tm[2] = hour
    if ($tm[2] == 0 && ($urlErrors || $doapErrors)) {
        my $smtp = Net::SMTP->new("localhost");
        my $to="Site Development <site-dev\@apache.org>";
        if ($smtp) {
            $smtp->mail('apsite@apache.org'); # From address (the script is run by the apsite login currently)
            $smtp->to($to);
            $smtp->data();
            $smtp->datasend("To: $to\n");
            $smtp->datasend("Subject: DOAP Error Report\n\n");
            $smtp->datasend("Errors getting files\n");
            $smtp->datasend($urlErrors);
            $smtp->datasend("Processing errors\n");
            $smtp->datasend($doapErrors);
            $smtp->dataend();
            $smtp->quit();
        } else {
            print "Error sending email report!\n";
        }
    }
    cleanDOAPFiles(); # Remove any DOAP files not in %fileName / %feeds
}

# make doap xdocs
my $xslt = new xsltProc();
print "Creating Project Listing (quick.xml) from DOAP files... ";
if (! $xslt->processFile("templates/doap2xdocs.xsl", $fileList)) {
	my $tmp=$xslt->output();
    print "Failed $tmp\n";
    exit(1);
}
write_file("xdocs/indexes/quick.xml", $xslt->output());
print "OK\n";

print "Creating RSS from DOAP files... ";
if (! $xslt->processFile("templates/doap2rss.xsl", $fileList)) {
	my $tmp=$xslt->output();
    print "Failed $tmp\n";
    exit(1);
}
print "OK\n";

print "Creating Atom from DOAP files... ";
if (! $xslt->processFile("templates/doap2atom.xsl", $fileList)) {
	my $tmp=$xslt->output();
    print "Failed $tmp\n";
    exit(1);
}
print "OK\n";

print "Creating RSS Release file... ";
if (! $xslt->processFile("templates/releases_rss.xsl", $fileList)) {
	my $tmp=$xslt->output();
    print "Failed $tmp\n";
    exit(1);
}
write_file(catfile($baseDir, "html/feeds/rss.xml"), $xslt->output());
print "OK\n";

print "Creating Atom Release file... ";
if (! $xslt->processFile("templates/releases_atom.xsl", $fileList)) {
	my $tmp=$xslt->output();
    print "Failed $tmp\n";
    exit(1);
}
write_file(catfile($baseDir, "html/feeds/atom.xml"), $xslt->output());
print "OK\n";

my @indexes = <indexes/*.xml>;
$xslt->setTempDirectory("templates");
print "Processing index stylesheets...\n";
my $idxTmpl = catfile($baseDir, "templates/makeIndex.xsl");
foreach my $i (@indexes) {
    my $idxFn = catfile('xdocs', 'indexes', basename($i));
    print "\t".basename($i)."...";
    if (!$xslt->processTwoSteps($idxTmpl, $i, $fileList)) {
        print "failed\n";
        print $xslt->output()."\n";
    } else {
        write_file($idxFn, $xslt->output());
        print "OK\n";
    }
}

############ Subroutines ##############################

sub unixpath($){ # Convert path to unix style (needed for XSLT)
	my $file=shift;
	$file =~ s!\\!/!g if $^O eq 'MSWin32';
	return $file
}

sub cleanGeneratedFiles
{
    my @dirty = (
        'xdocs/indexes/*.xml',
        'xdocs/projects/*.xml',
        'html/*.html',
        'html/docs/*.html',
        'html/feeds/*.xml',
        'html/feeds/atom/*.xml',
        'html/feeds/rss/*.xml',
        'html/indexes/*.html',
        'html/projects/*.html',
        "$tmpDir/doap_temp_*.rdf",
        'templates/temp.xsl.200*_*',
    );

    foreach my $d (@dirty) {
        my $path = catfile($baseDir, $d);
        unlink glob($path);
    }
}

# Read the file '$doapList' and get a list of all the locations we should
# get files from.
# Output is stored in %feeds: key: location, value=1
sub readDOAPLocations
{
    my $xml = XML::dspp->new();
    if (! $xml->parseFile($doapList)) {
        print "Unable to parse file '$doapList'\n";
        return 0;
    }
    my $root = $xml->getRoot;
    if ($root->Name() ne 'doapFiles') {
        print "'$doapList' isn't a list of doap files!\n";
        return 0;
    }
    my @locs = $root->getChildren('location');
    foreach my $l (@locs) {
        $feeds{$l->Data()}=1;
    }
}

# Read the list of files already listed in 'doap/files.list'.
# Output stored in:
# - %id: key=url, value=Attribute(id)
# - %fileName: key=url, value=File(data)
# - %projectName: key=url, value=Name(data)

sub readDOAPList
{
    my $xml = XML::dspp->new();
    # workround for bug in XML::dspp which cannot handle an empty <doapFiles/>
    if (! eval {$xml->parseFile($fileList)}) {
        print "Unable to parse file '$fileList'\n";
        return 0;
    }
    my $root = $xml->getRoot;
    if ($root->Name() ne 'doapFiles') {
        print "'fileList' isn't a list of doap files, removing it!\n";
        unlink($fileList);
        return 1;
    }
    my @locs = $root->getChildren('doapFile');
    my %ids=();
    my %names=();
    my %files=();
    foreach my $l (@locs) {
        my $url  = $l->getChildData('URL');
        my $file = $l->getChildData('File');
        my $id   = $l->Attribute('id');
        my $name = $l->getChildData('Name');
        print "Duplicate URL $url in $fileList\n" if defined $id{$url};
        print "Duplicate id $id in $fileList\n"     if $ids{$id}++ > 0;
        print "Duplicate Name $name in $fileList\n" if $names{$name}++ > 0;
        print "Duplicate file $file in $fileList\n" if $files{$file}++ > 0;
        $id{$url} = $id;
        $fileName{$url} = unixpath $file;
        $projectName{$url} = $name;
    }
    return 1;
}

# For each URL in %feeds, connects to the host and tries to read the file using Get()
# The value of $feeds{URL} is set to the return from Get(), unless an error occured before calling Get()
# TODO should %feeds be set to 0 if Get is not called?
sub updateDOAPFiles
{
    my $tried = 0;
    my $updated = 0;
    my $failed = 0;

    print "Updating all DOAP files ('.' no change, 'U' updated, 'X' failed, 'R' reopened socket)\n";

    my $prev = $|;
    $| = 1;

    foreach my $d (sort(keys(%feeds))) {
        $tried++;
        if ($d !~ m!^https?://([-0-9a-zA-Z\.]*)/!) {
            $urlErrors .= "$d doesn't seem to be a valid URL\n";
            next;
        }
        my $rv = Get($d, $tried);
        $feeds{$d} = $rv;
        if ($rv == 1) {# uptodate
            print ".";
        } elsif ($rv == 2) {# downloaded
            $updated++;
            print "U";
        } else {# Assume 0, i.e. error
            $failed++;
            print "X";
        }
    }
    $| = $prev;
    print "\n\n";
    print "Attempted to fetch $tried DOAP files. $failed files failed.\n";
    print "\n";
}

sub writeDOAPList
{
    my $xml = XML::dspp->new();
    my $root = $xml->setRoot('doapFiles');

    foreach my $u (sort(keys(%feeds))) {
    	if (defined$id{$u}){# Check that there is an entry
            my $e = $root->addElement('doapFile');
            $e->setAttribute('id', $id{$u});
            $e->addElement('URL', $u);
            $e->addElement('File', $fileName{$u});
            $e->addElement('Name', $projectName{$u});
    	}
    }
    write_file($fileList, $xml->asText());
}

# Read from URL and store in doap_temp_n.rdf file
#
# Uses If-Modified-Since header to avoid downloading files unnecessarily.
#
#
# Input:
# $fileName{url} is checked to obtain the mod. date
#
# Output:
# $fileName{url} updated with temp file name
# Return:
# 0 - error
# 1 - HTTP status 304 returned, i.e. local file is up to date
# 2 - success
#
sub Get
{
    my ($url, $i) = @_;

    return 0 unless $url;

    my $request = HTTP::Request->new(GET => $url);
    if ($fileName{$url} && -f $fileName{$url}) {
        my $tm = (stat($fileName{$url}))[9];
        $request->header('If-Modified-Since' => strftime('%a, %d %b %Y %H:%M:%S GMT', gmtime($tm)));
    }
    my $res = $ua->request($request);
    my $status = $res->code;

    if ($status == 304) {
        return 1; # OK, no update required
    } elsif ($status != 200) {
    	my $peer = $res->header('Client-Peer');
    	my $msg = $res->message;
        $urlErrors .= "Failed to get '$url'\tStatus = '$status' - '$msg' using $peer\n";
        return 0; # Error
    }

    $fileName{$url} = catfile($tmpDir, "doap_temp_$i.rdf");
    my $data = $res->content;# We just want a binary copy of the file; no need to decode
    write_file($fileName{$url}, $data);
    return 2;
}

# Process the DOAP files found in %feeds.
# If the %feeds value is:
# 0=file skipped
# 1=file skipped (and value set to 0)
# 2=file is processed:
#
# The file is read as XML, and the project name extracted using projectName.xsl
# this is massaged to generate a valid file name stem, and the 
# temporary doap file is moved to its new file, and %fileName updated with the new name

sub processDOAPFiles
{
    my %names=(); # Check that names are unique. Key: name Value: URL
    my $files = 0;
    my $del = 0;
    my $upd = 0;
    print "Processing DOAP files ('.' OK, 'D' download failed, 'X' failed to process file)\n";
    my $templFn = catfile($baseDir, 'templates', 'projectName.xsl');

    my $xslt = new xsltProc();
    foreach my $u (sort(keys(%feeds))) {
        $files++;
        if ($feeds{$u} == 1) {
            print ".";
            $feeds{$u} = 0;
            next;
        } elsif ($feeds{$u} == 0) {
            $del++;
            print "D";
            #delete $feeds{$u}; # keep data in case of a temporary error
            next;
        }
        
        # Presumably $feeds{$u}==2 here, i.e. Get() succeeded
        
        if (! $xslt->processFile($templFn, $fileName{$u})) {
            $doapErrors .= "Failed to get project name from file\n";
            $doapErrors .= $xslt->output();
            $del++;
            delete $feeds{$u};
            print "X";
            next;
        }

        $projectName{$u} = $xslt->output();
        # N.B. has to agree with utils.xsl:<xsl:template name="toLowerSanitise">
        ($id{$u} = lc($projectName{$u})) =~ s![^a-z0-9_+-]!_!g;# Sanitize - keep only a-z0-9+_-
        $id{$u} =~ s/^apache_// or $doapErrors .= "$projectName{$u} in $u did not start with Apache\n";

        if (defined $names{$id{$u}}) { # Check for name collisions
            $doapErrors .= "$id{$u} in $u already used by $names{$id{$u}}\n";
        } else {
            $names{$id{$u}}=$u;
        }

        my $fn = catfile($doapDir, $id{$u}.'.rdf');
        if (! move($fileName{$u}, $fn)) {
            $doapErrors .= "Moving file from $fileName{$u} to $fn.\nError: $!\n";
            $del++;
            delete($feeds{$u});
            print "X";
            next;
        }
        $upd++;
        $fileName{$u} = unixpath $fn;
        print ".";
    }
    print "\n\n";
    print "Total of $files checked, $del deleted due to errors, $upd updated\n\n";
}

# Remove any DOAP files not in %fileName / %feeds
# These are files that are no longer in files.xml

sub cleanDOAPFiles{
	print "Removing obsolete DOAP files...\n";
	my $fileList = catfile($doapDir, "*.rdf");
	my %names = reverse %fileName;# Turn values into a hash
    for my $f (glob($fileList)){
    	my $url = $names{unixpath $f};
    	if (!defined($url) || !defined $feeds{$url}){
    		print "Removing $f\n";
    		unlink $f || warn "Could not remove $f : $!\n"
    	}
    }
    print "Completed removing obsolete DOAP files.\n";
}

=cut

=head1 COPYRIGHT

  Copyright 2003-2010  The Apache Software Foundation

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
