#!/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