#!/usr/bin/perl -s

use warnings;
use strict;

use YAML qw/LoadFile/;
use File::Copy;
use File::Spec::Functions qw'catfile catdir';
use File::Path;
use Lingua::Jspell::ConfigData;
use Cwd;
use LWP::Simple;
use Archive::Any;
use ExtUtils::Manifest qw/manicheck/;

our ($v);

our $LIBDIR = Lingua::Jspell::ConfigData->config('libdir');

for (@ARGV) {
    if (-d $_) {
        install_directory($_);
    } elsif (-f $_ && /^(.*)\.(dic|aff|hash|yaml)$/) {
        my $basename = $1;
        install_by_basename($basename);
    } elsif (-f "$_\.dic") {
        my $basename = $_;
        install_by_basename($basename);
    } else {
        my $language = lc;

        my $host = 'http://natura.di.uminho.pt/';
        my $url = "${host}download/sources/Dictionaries/jspell/LATEST/jspell.${language}-latest.tar.gz";

        fetch_dic($url);
    }
}

sub install_by_basename {
    my $basename = shift;
    if (-f "$basename.yaml") {
        mkdir "_OUT";
        install_by_yaml("$basename.yaml");
    }
    elsif (-f "$basename.aff") {
        mkdir "_OUT";
        install_by_lang($basename);
    }
    else {
        die "Can't guess dictionary structure."
    }
}

sub install_by_yaml {
    my $yaml = shift;
    my $s = LoadFile($yaml);
    my ($lang,@syn) = @{$s->{META}{IDS}};
    die "YAML file doesn't contain a META/IDS section\n" unless $lang;
    copy($yaml, catfile('_OUT',"$lang.yaml"));
    continue_installation($lang, @syn);
}

sub install_by_lang {
    my $lang = shift;
    continue_installation($lang);
}

sub install_directory {
    my $path = shift;
    chdir $path or die "Can't access $path.";
    mkdir "_OUT";


    my @syn;

    # 1. check manifest...
    $v and print STDERR "- checking MANIFEST file\n";
    my @missing_files = manicheck;
    die "The following files are missing: ", join(", ", @missing_files) if @missing_files;

    # 2. check for a yaml file.
    $v and print STDERR "- loading YAML file...";
    my ($yaml) = (<*.yaml>,<*.yml>);
    if ($yaml) {
        $v and print STDERR " OK\n";
        install_by_yaml($yaml);
    } else {
        $v and print STDERR " FAIL\n";
        $v and print STDERR "- trying to guess a language name...";
        my ($aff) = <*.aff>;
        if ($aff and $aff =~ /(.*)\.aff/) {
            $v and print STDERR " OK\n";
            install_by_lang($1);
        } else {
            $v and print STDERR " FAIL\n";
            die "Can't find a suitable language name\n"
        }
    }
}

sub continue_installation {
    my ($lang, @syn) = @_;

    # 3. copy affix file
    $v and print STDERR "- checking for .aff file existence...";
    my ($aff) = <*.aff>;
    copy($aff, catfile('_OUT',"$lang.aff"));
    $v and print STDERR " OK\n";

    # 4. create .dic file
    $v and print STDERR "- concatenating .dic files...";
    my (@dic) = <*.dic>;
    open OUT, ">", catfile("_OUT", "$lang.dic") or die $!;
    binmode OUT;
    for my $dic (@dic) {
        my $buf;
        open IN, "<", $dic or die $!;
        binmode IN;
        while(read IN, $buf, 100) {
            print OUT $buf;
        }
        close IN;
    }
    close OUT;
    $v and print STDERR " OK\n";

    # 5. create .irr file
    $v and print STDERR "- concatenating .irr files...";
    my (@irr) = <*.irr>;
    if (@irr) {
        open OUT, ">", catfile("_OUT", "$lang.irr") or die $!;
        binmode OUT;
        for my $irr (@irr) {
            my $buf;
            open IN, "<", $irr or die $!;
            binmode IN;
            while(read IN, $buf, 100) {
                print OUT $buf;
            }
            close IN;
        }
        close OUT;
    }
    $v and print STDERR " OK\n";

    # 6. create .hash file
    $v and print STDERR "- creating .hash file...";
    my $JBUILD = Lingua::Jspell::ConfigData->config("jbuild");
    die "Need jbuild binary...\n" unless -x $JBUILD;
    my $cwd = getcwd;
    chdir '_OUT';
    `$JBUILD $lang.dic $lang.aff $lang.hash`;
    chdir $cwd;
    $v and print STDERR " OK\n";

    # 7. try to create the output dir
    $v and print STDERR "- installing files...";
    mkpath(catdir($LIBDIR,"jspell"));
    for (<_OUT/*>) {
        copy($_, catfile($LIBDIR,"jspell")) or die "Can't copy files\n";
    }
    $v and print STDERR " OK\n";
    rmtree "_OUT";

    # 8. create symlinks...
    $v and print STDERR "- creating symlinks...";
    for my $ext (qw/dic hash aff irr yaml/) {
        for my $syn (@syn) {
            my $path = catdir($LIBDIR,"jspell");
            my $file = catfile($path,"$lang.$ext");
            if (-f $file) {
                my $error = eval { symlink $file, catfile($path,"$syn.$ext"); 1 };
                link $file, catfile($path,"$syn.$ext") if $error;
            }
        }
    }
    $v and print STDERR " OK\n";
}

sub fetch_dic {
    my $url = shift;

    $v and print STDERR "- fetching $url...";
    if (is_success(getstore($url, "dic.tar.gz"))) {
        $v and print STDERR " OK\n";

        $v and print STDERR "- unarchiving package...";
    	my $archive = Archive::Any->new("dic.tar.gz");
    	my ($dir) = $archive->files;
    	$archive->extract();	
        $v and print STDERR "- OK\n";

        my $cwd = getcwd;
        install_directory($dir);
        chdir $cwd;
        rmtree $dir;
        unlink 'dic.tar.gz';
    } else {
        $v and print STDERR " FAIL\n";
        warn "Failed to fetch the dictionary file. Check if that language is available.";
    }
}

=encoding utf-8

=head1 NAME

jspell-installdic - automates the installation of a remote jspell dictionary

=head1 SYNOPSIS

   jspell-installdic pt en

=head1 DESCRIPTION

Tries to fetch a binary jspell dictionary distribution for the
supplied languages and install them on the system

=head1 SEE ALSO

jspell(1), Lingua::Jspell(3), perl(1)

=head1 AUTHOR

Alberto Manuel Brandão Simões, E<lt>ambs@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Alberto Manuel Brandão Simões

=cut