File Coverage

blib/lib/Treex/Core/Resource.pm

Criterion	Covered	Total	%
statement	29	68	42.6
branch	0	24	0.0
condition	0	6	0.0
subroutine	10	11	90.9
pod	1	1	100.0
total	40	110	36.3

package Treex::Core::Resource;
$Treex::Core::Resource::VERSION = '2.20210102';
use strict;
use warnings;

use 5.010;

#use Moose;
#use Treex::Core::Common;
use LWP::Simple;    #TODO rewrite using LWP:UserAgent to show progress
use File::Path 2.08 qw(make_path);
use File::Spec;
use Treex::Core::Log;
use Treex::Core::Config;

use Exporter 'import';
use vars qw(@EXPORT_OK);
@EXPORT_OK = qw(require_file_from_share);

sub require_file_from_share {
    my ( $path_to_file, $who_wants_it, $make_executable, $skip_download ) = @_;

    # The following three cases are handled first
    #   ./relative_path
    #   ../relative_path
    #   /absolute_path
    # These files are not searched within Treex Share.
    if ($path_to_file =~ m|^[.]{0,2}/|) {
        log_debug("Looking for absolute or relative path $path_to_file\n");
        return $path_to_file if -e $path_to_file;
        my $file = File::Spec->rel2abs($path_to_file);
        log_fatal "Cannot find '$path_to_file'.\nNote that it starts with '/' or '.', so it is not searched for within Treex Share.\nFile '$file' does not exist.\n";
    }

    my $writable;    #will store first writable directory found
    SEARCH:
    foreach my $resource_dir ( Treex::Core::Config->resource_path() ) {
        next if (!$resource_dir);
        my $file = File::Spec->catfile( $resource_dir, $path_to_file );
        log_debug("Trying $file\n");
        if ( -e $file ) {
            log_debug("Found $file\n");
            return $file;
        }
        if ( !defined $writable ) {
            if ( !-e $resource_dir ) {
                make_path($resource_dir);
            }
            if ( -d $resource_dir && -w $resource_dir ) {
                $writable = $resource_dir;
                log_debug("Found writable directory: $writable");
            }
        }
    }
    $who_wants_it = defined $who_wants_it ? " by $who_wants_it" : '';
    log_info("Shared file '$path_to_file' is missing$who_wants_it.");
    log_fatal("Cannot find writable directory for downloading from share") if !defined $writable;

    my $file = "$writable/$path_to_file";

    # first ensure that the directory exists
    my $directory = $file;
    $directory =~ s/[^\/]*$//;
    File::Path::mkpath($directory);

    # skip download, just return the path, the caller block will handle the download itself
    if ($skip_download){
        log_warn("File $file does not exist, auto-download skipped.");
        return $file;
    }

    my $url = Treex::Core::Config->share_url() . "/$path_to_file";
    log_info("Trying to download $url");

    # downloading the file using LWP::Simple
    my $response_code = getstore( $url, $file );

    if ( $response_code == 200 ) {
        log_info("Successfully downloaded to $file");
    }
    else {
        log_fatal(
            "Error when trying to download "
                . "$url and to store it as $file ($response_code)\n"
        );
    }

    # TODO: better solution
    if ( $file =~ /installed_tools/ || $make_executable ) {
        chmod 0755, $file;
    }
    return $file;
}

1;

__END__


=encoding utf-8

=head1 NAME

Treex::Core::Resource - Access to shared resources

=head1 VERSION

version 2.20210102

=head1 SYNOPSIS

use Treex::Core::Resource qw(require_file_from_share);
my $path = require_file_from_share('relative/path/to/file/within/Treex/Share');
open my $MODEL, '<', $path or log_fatal($!);

# or
my $path = require_file_from_share('./relative/path/from/the/current/directory');
my $path = require_file_from_share('/absolute/path');

=head1 DESCRIPTION

This module provides access to shared resources (e.g. models). First it tries to locate it on local computer.
If not found, download from server (L<http://ufallab.ms.mff.cuni.cz/>).
If the path starts with "." or "/" it is searched in the local file system (and not in Treex Share).

=head1 SUBROUTINES

=over

=item require_file_from_share($path_to_file, $who_wants_it, $make_executable, $skip_download)

Try to locate file in local resource paths, if not found, try to download it and stores it to first writable path.
Obtains paths from L<Treex::Core::Config-E<gt>resource_path()|Treex::Core::Config/resource_path>
Returns path to file.

If C<$make_executable> is true, execute rights are set on the downloaded file.

If C<$skip_download> is true, automatic download is skipped and only the path tho the file or the first
writable path is returned. The caller block must check the existence of the file and handle the download
itself (useful for downloading and unpacking of larger archives).

=back

=head1 AUTHOR

Zdeněk Žabokrtský <[e-mail]>

Tomáš Kraut <[e-mail]>

Martin Popel <[e-mail]>

=head1 COPYRIGHT AND LICENSE

Copyright © 2011,2015 by Institute of Formal and Applied Linguistics, Charles University in Prague

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.