view release on metacpan or  search on metacpan

lib/Lingua/TreeTagger/Installer.pm  view on Meta::CPAN

    my ($self, $from, $to) = @_;

    $self->verbose(" - installing", basename($from), "into $to");
    $to .= "/" unless $to =~ m{/$};
    $to .= basename($from);
    if (-f $to && not $self->{force}) {
        die "Target file exists.\nProbably another version of parameter file was already installed.\nWon't install without force (-f)\n";
    }
    cp $from => $to or die "Installation failed. You have write permissions?\n";
}

sub install_to_cmd {
    my ($self, $file) = @_;

    require Lingua::TreeTagger::Installer::ConfigData;
    my $treebin = Lingua::TreeTagger::Installer::ConfigData->config('treebin');

    $self->custom_install($file, $treebin);
    chmod 0755, "$treebin/" . basename($file);
}

sub install_to_bin {
    my ($self, $file) = @_;

    require Lingua::TreeTagger::Installer::ConfigData;
    my $bin = Lingua::TreeTagger::Installer::ConfigData->config('bin');

    $self->custom_install($file, $bin);
    chmod 0755, "$bin/" . basename($file);
}

sub install_to_lib {
    my ($self, $file) = @_;

    require Lingua::TreeTagger::Installer::ConfigData;
    my $treelib = Lingua::TreeTagger::Installer::ConfigData->config('treelib');

    $self->custom_install($file, $treelib);
}

sub new {
    my $class = shift;
    my %ops = @_;
    local $/ = "";
    open R, "<", "$ENV{HOME}/.treetagger" or die "Can't find .treetagger config file\n";
    my $data = Load( <R> );
    close R;

    my $self = { data => $data };

    for my $l (keys %{$data->{languages}}) {
        for my $e (@{$data->{languages}{$l}}) {
            $self->{lookup}{$e->{id}} = clone $e;
            $self->{lookup}{$e->{id}}{lang} = $l;
        }
    }

    $self->{verbose}++ if $ops{verbose};
    $self->{force}++   if $ops{force};

    return bless $self => $class
}

sub verbose {
    my ($self, @message) = @_;
    if ($self->{verbose}) {
        print STDERR join(" " => @message), "\n";
    }
}

sub list_parameter_files {
    my $self = shift;
    my $count = 0;
    print "Listing available and installed parameter files\n";
    for my $lang (keys %{$self->{data}{languages}}) {
        for my $par (@{$self->{data}{languages}{$lang}}) {
            my $author = exists($par->{author}) ? " by $par->{author}" : "";
            my $parfile = exists($par->{parfile}) ? $par->{parfile} : undef;
            if ($parfile) {
                print "$par->{id} [INSTALLED] $lang ($par->{encoding})$author as $parfile.\n";
            } else {
                print "$par->{id} [AVAILABLE] $lang ($par->{encoding})$author.\n";
            }
        }
    }
}

sub installed {
    my ($self, $parameter, $filename) = @_;
    my $l = $self->{lookup}{$parameter}{lang};
    for my $e (@{$self->{data}{languages}{$l}}) {
        $e->{parfile} = $filename if $e->{id} eq $parameter;
    }
    $self->save;
}

sub install {
    my ($self, $parameter) = @_;

    $parameter = uc $parameter;
    return "unknown code" unless exists($self->{lookup}{$parameter});

    my $url  = $self->{lookup}{$parameter}{url};
    my $lang = $self->{lookup}{$parameter}{lang};
    my $filename = $url;
    $filename =~ s{^.*/}{};

    $self->verbose(" - downloading into $filename");
    getstore $url => $filename;

    if (exists($self->{lookup}{$parameter}{manifest})) {
        if ($filename =~ /tar.gz$/) {
            my $tgz = Archive::Any->new( $filename );

            my $dir = tempdir CLEANUP => 1;
            $tgz->extract( $dir );

            unlink $filename;
            my $files = $self->{lookup}{$parameter}{manifest};
            for my $f (@$files) {