view release on metacpan or  search on metacpan

bin/import-itol.pl  view on Meta::CPAN

#!/usr/bin/env perl
# PODNAME: import-itol.pl
# ABSTRACT: Upload trees and associate metadata files to iTOL
# CONTRIBUTOR: Valerian LUPO <valerian.lupo@uliege.be>

use Modern::Perl '2011';
use autodie;

use Getopt::Euclid qw(:vars);
use Smart::Comments '###';

use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
use File::Basename;
use File::Find::Rule;
use HTTP::Request::Common;
use LWP::UserAgent;


my $upload_url = "https://itol.embl.de/batch_uploader.cgi";

# optionally setup tree id outfile
my $out;
if ($ARGV_tree_id_out) {
    open $out, '>', $ARGV_tree_id_out;
    say {$out} '# ' . join "\t", qw ( file id );
}

FILE:
for my $infile (@ARGV_infiles) {
    ### Processing: $infile

    # write ZIP archive file
    my $zip = Archive::Zip->new();
    my ($basename, $dir, $suffix) = fileparse($infile, qr{\.[^.]*}xms);
    my $zipfile = "$basename.zip";

    my $newname = "$basename.tree";     # iTOL wants a .tree suffix
    symlink($infile, $newname);         # TODO: improve this
    $zip->addFile($newname);

    $zip->addFile($_) for File::Find::Rule->file()
        ->maxdepth(1)->name("$basename\-*.txt")->in($dir);

    ### Storing ZIP file: $zipfile
    unless ( $zip->writeToFileNamed($zipfile) == AZ_OK ) {
        warn <<"EOT";
Warning: cannot ZIP archive file; skipping!
EOT
        next FILE;
    }

    # delete the symlink
    unlink($newname);                   # TODO: improve this

    # prepare the data
    my %data_for;
    $data_for{ 'zipFile'         } = [ $zipfile ];
    $data_for{ 'treeName'        } = $basename;
    $data_for{ 'APIkey'          } = $ARGV_api_key;
    $data_for{ 'projectName'     } = $ARGV_project;
    $data_for{ 'treeDescription' } = $ARGV_description if $ARGV_description;

    # submit the data
    my $ua = LWP::UserAgent->new();
    $ua->agent("iTOLbatchUploader4.0");
    my $request  = POST $upload_url,
        Content_Type => 'form-data', Content => [ %data_for ];
    my $response = $ua->request($request);

    dump_id($response, $basename);
}


# TODO: use standard BMC error message scheme
sub dump_id {
    my $response = shift;
    my $file     = shift;

    if ( $response->is_success() ) {
        my @res = split /\n/xms, $response->content;

        # check for an upload error
        if ($res[-1] =~ /^ERR/xms) {
            warn <<"EOT";
Warning: upload failed; iTOL returned the following error message:
$res[$#res]
EOT
        }

        # upload without warnings, id on first line
        if ($res[0] =~ /^SUCCESS: \s (\S+)/xms) {
            my $tree_id = $1;
            print <<"EOT";
Note: Upload successful; your tree can be accessed through the following id:
$tree_id
EOT
            say {$out} join "\t", $file, $tree_id if $out;
        }
    }

    else {
        warn <<"EOT";
Warning: iTOL returned a web server error; full message follows:
EOT
        print $response->as_string;
    }

    return;
}

__END__

=pod

=head1 NAME

import-itol.pl - Upload trees and associate metadata files to iTOL

=head1 VERSION

version 0.252040

=head1 USAGE

    import-itol.pl <infiles> --api-key=<string> --project=<string>
        [optional arguments]

=head1 REQUIRED ARGUMENTS

This script is based on C<iTOL_uploader.pl>.

=over

=item <infiles>

Path to input TRE files [repeatable argument].

=for Euclid: infiles.type: readable
    repeatable

=item --api-key=<string>

Your API key, which can be generated through your user account options menu
(while logged in, click your name in the top right corner of any page to access
the option) [default: none].

=for Euclid: string.type: string

=item --project=<string>

Your project name from your user account [default: none].

=for Euclid: string.type: string

=back

=head1 OPTIONS

=over

=item --description=<string>

Any description for your tree(s) [default: no].

=for Euclid: string.type: string

=item --tree-id-out=<file>

Path to local outfile collecting the unique tree ids generated by iTOL for all
infiles [default: none]. Its tabular output can then be forwarded to the script
L<export-itol.pl> to export formatted trees from iTOL.

=for Euclid: file.type: writable

=item --version

=item --usage

=item --help

=item --man

Print the usual program information

=back

=head1 AUTHOR

Denis BAURAIN <denis.baurain@uliege.be>