#!/usr/bin/perl
# reindex.pl - Crawler/Indexer for Lua packages.
# (c) 2009 David Manura. MIT License.

use strict;
use Storable;

sub update_local_mirror {
  # Download LuaDist packages.
  `mkdir -p luadist && cd luadist && \\
   wget --mirror --no-parent --accept dist --no-directories \\
     http://luadist.org/dists/LuaModules/`;
  `mkdir -p luadistutil && cd luadistutil && \\
   wget --mirror --no-parent --accept dist --no-directories \\
     http://luadist.org/dists/LuaUtils/`;

  # Download Debian packages.
  `svn checkout svn://svn.debian.org/pkg-lua/packages/ debian`;

  # Download LuaRocks packages.
  #TODO-need to test when luaforge is back online
  #`wget -mirror --no-parent --accept rock,rockspec --no-directories \\
  #   http://luarocks.luaforge.net/rocks/
}

sub unpack_luadist_repo {
    my ($dirname) = @_;

    opendir(my $fh, $dirname) or die $!;
    my @filenames = grep {! /^\./} readdir($fh);
    close($fh);

    `mkdir -p $dirname-extract`;

    for my $filename (@filenames) {

        if (! -e "$dirname-extract/$filename" ||
            -M "$dirname-extract/$filename" > -M "$dirname/$filename")
        {
            `rm -fr tmp && mkdir -p tmp && \\
             (cd tmp && unzip ../$dirname/$filename) && \\
             mkdir -p $dirname-extract/$filename && \\
             mv tmp/*/* $dirname-extract/$filename && \\
             rm -fr tmp`;
        }
    }
}

sub unpack_luadist {
    for my $repo ('luadist', 'luadistutil') {
        &unpack_luadist_repo($repo);
    }
}

sub unpack_luarocks {
    #TODO
}

sub unpack_debian {
    #TODO
}

sub unpack_all {
    &unpack_luadist();
    &unpack_debian();
    &unpack_luarocks();
}

# Load dist.info file at filename $filename, returning
# hashref representation.
sub load_luadist_dist {
    my ($filename) = @_;

    open(my $fh, $filename) or die $!;
    my $text = do { local $/; <$fh> };

    my $dist = {};
    
    #2DO: would be better to use library for this, e.g. Inline::Lua
    #2DO: this parsing is currently only approximate.
    sub parse_field {
        my ($text, $key) = @_;
        if ($text =~ m{^$key\s*=\s*\"(.*?)\"}sm) {
            return $1;
        }
        elsif ($text =~ m/^$key\s*=\s*\{(.*?)\}/sm) {
            my $fields = $1;
            my @fields = ($fields =~ /\"(.*?)\"/);
            return \@fields;
        }
    };

    $dist->{name} = &parse_field($text, 'name');
    $dist->{version} = &parse_field($text, 'version');
    $dist->{desc} = &parse_field($text, 'desc');
    $dist->{author} = &parse_field($text, 'author');
    $dist->{license} = &parse_field($text, 'license');
    $dist->{url} = &parse_field($text, 'url');
    $dist->{dist_maintainer} = &parse_field($text, 'maintainer');
    $dist->{source} = &parse_field($text, 'source');
    $dist->{source_md5} = &parse_field($text, 'source_md5');
    $dist->{depends} = &parse_field($text, 'depends');
    $dist->{groups} = &parse_field($text, 'groups');
    # use Data::Dumper; print Dumper($dist);
    return $dist;
}

sub index_luadist_repo {
    my ($dists, $dirname, $urlbase) = @_;
    opendir(my $fh, "luadist-extract") or die $!;
    my @filenames = grep {! /^\./} readdir($fh);
    close($fh);

    for my $filename (@filenames) {
        (my $distname = $filename) =~ s/\.dist$//;
        my $distfilename = "$dirname-extract/$filename/dist.info";
        if (-e $distfilename) {
            my $dist = &load_luadist_dist($distfilename);
            $dist->{type} = 'LuaDist';
            $dist->{source_dist} = "$urlbase$filename";
            $dist->{repo} = "$dirname";
	    $dists->{$distname} = $dist;
	}
    }
}

sub index_luadist {
    my $dists = {};
    &index_luadist_repo($dists, "luadist", "http://luadist.org/dists/LuaModules/");
    &index_luadist_repo($dists, "luadistutil", "http://luadist.org/dists/LuaUtils/");

    `mkdir -p database`;
    store $dists, "database/index";
}

sub index_all {
    &index_luadist();
    #TODO: LuaRocks and debian
}

# &update_local_mirror();

&unpack_all();

&index_all();

print "DONE\n";