view release on metacpan or  search on metacpan

lib/Acme/Globus.pm  view on Meta::CPAN

package Acme::Globus;

# ABSTRACT: Interface to the Globus research data sharing service

use strict;
use warnings;

use Carp ;
use JSON ;
use Net::OpenSSH ;

=pod

=head1 NAME

Globus - Object-Oriented interface to Globus

=head1 DESCRIPTION

Globus is a tool that allows the sharing of scientific data between 
researchers and institutions. Globus enables you to transfer your 
data using just a web browser, or using their SSH interface at 
cli.globusonline.org.

This is a client library for the Globus CLI.

For detailed documentation of the API, 
see L<http://dev.globus.org/cli/reference>.

=head1 CAVEATS

This code is a work in progress, focusing on my needs at the moment 
rather than covering all the capabilities of the Globus CLI. It is
therefore very stubtastic.

This module also relies very much on SSH, and thus the rules of 
private and public keys. Therefore, using it as a shared tool would
be ill-advised if not impossible.

=head1 SYNOPSIS

    my $g = Globus->new($username,$path_to_ssh_key) ;
    $g->endpoint_add_shared( 'institution#endpoint', $directory, $endpoint_name ) ;
    $g->acl_add( $endpoint . '/', 'djacoby@example.com' ) ;
    
=head1 METHODS

=head2 BASICS

=head3 B<new>

    Creates a new Globus object. Takes two options: 
    the username and path to the SSH key you use to connect to Globus.

=head3 B<set_username>

=head3 B<set_key_path>

=head3 B<get_username>

=head3 B<get_key_path>

    These commands return and change the username and keypath you use to 
    connect to Globus.

=cut

sub new {
    my ( $class, $username, $key_path ) = @_ ;
    my $self = {} ;
    bless $self, $class ;
    $self->{username} = $username || 'none' ;
    $self->{key_path} = $key_path || 'none' ;
    return $self ;
    }

sub set_username {
    my ( $self, $username ) = @_ ;
    $self->{username} = $username ;
    }

sub set_key_path {
    my ( $self, $key_path ) = @_ ;
    $self->{key_path} = $key_path ;
    }

sub get_username {
    my ($self) = @_ ;
    return $self->{username} || 'NO USER' ;
    }

sub get_key_path {
    my ($self) = @_ ;
    return $self->{key_path} || 'NO KEY PATH' ;
    }

=head2 TASK MANAGEMENT

lib/Acme/Globus.pm  view on Meta::CPAN

    return wantarray ? %result : \%result ;
    }

sub endpoint_remove {
    my ( $self, $endpoint ) = @_ ;
    my $command = qq{endpoint-remove $endpoint} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    return $result ;
    }

# Sucks. Use endpoint_search instead
sub endpoint_details {
    my ( $self, $endpoint ) = @_ ;
    my $command = qq{endpoint-details $endpoint} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;

    my %result = map {
        chomp ;
        my ( $key, $value ) = split m{\s*:\s*}, $_ ;
        $key => $value
        } split m{\n}, $result ;

    return wantarray ? %result : \%result ;
    }

=head3 B<endpoint_activate>

=head3 B<endpoint_add>

=head3 B<endpoint_deactivate>

=head3 B<endpoint_modify>

=head3 B<endpoint_rename>

Stubs

=cut

sub endpoint_activate   { }
sub endpoint_add        { }
sub endpoint_deactivate { }
sub endpoint_modify     { }
sub endpoint_rename     { }

=head2 OTHER

=head3 B<help>   

=head3 B<history>

=head3 B<man>         

=head3 B<profile>

=head3 B<versions>

profile() returns information about the Globus user, including the email address 
and public key.

Otherwise stubs

=cut

sub profile {
    my ($self) = @_ ;
    my $command = qq{profile} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    my %output
        = map { my ( $k, $v ) = split m{:\s?}, $_ ; $k => $v } split m{\n},
        $result ;
    return wantarray ? %output : \%output ;
    }

sub help     { }
sub history  { }
sub man      { }
sub versions { }

sub _globus_action {
    my ( $command, $user, $key_path ) = @_ ;
    my $host = '@cli.globusonline.org' ;

    my $ssh = Net::OpenSSH->new(
        $user . $host,
        key_path => $key_path,
        async    => 0,
        ) ;

    $ssh->error
        and die "Couldn't establish SSH connection: " . $ssh->error ;

    my $debug = 0 ;

    say STDERR "\t" . '=' x 20 if $debug ;
    say STDERR "\t" . $command if $debug ;
    say STDERR "\t" . '-' x 20 if $debug ;

    my $response = $ssh->capture($command)
        or carp "remote command failed: " . $ssh->error ;

    return $response ;
    }

1 ;

=head1 LICENSE

Copyright (C) 2017, Dave Jacoby.

This program is free software, you can redistribute it and/or modify it 
under the terms of the Artistic License version 2.0.

=head1 AUTHOR

Dave Jacoby - L<jacoby.david@gmail.com>

=cut