Acme-Globus

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

NAME

    Globus - Object-Oriented interface to Globus

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
    http://dev.globus.org/cli/reference.

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.

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

=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.

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

=cut 

sub delete { }
sub rm     { }

sub scp {
    my ( $self, $from_path, $to_path, $recurse ) = @_ ;
    $recurse = $recurse ? '-r' : '' ;
    my $command = qq{scp $recurse $from_path $to_path} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    return $result ;
    }

sub transfer {
    my ( $self, $from_path, $to_path, $recurse ) = @_ ;
    $recurse = $recurse ? '-r' : '' ;
    my $command = qq{transfer $from_path $to_path} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    return $result ;
    }

=head2 FILE MANAGEMENT

=head3 B<ls>

Works?

=head3 B<rename>

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

=head3 B<mkdir>

Stubs

=cut

sub ls {
    my ( $self, $file_path ) = @_ ;
    my $command = qq{ls $file_path} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    my @result = split m{\r?\n}, $result ;
    return wantarray ? @result : \@result ;
    }

sub mkdir  { }
sub rename { }

=head2 ENDPOINT MANAGEMENT

=head3 B<acl_add>

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

acl_list() returns an array of hashes containing the information about 
each user with access to an endpoint, including the share ID and permissions.

=cut

sub identity_details {
    my ( $self, $identity_id ) = @_ ;
    my $command = qq{identity-details $identity_id } ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    return {} unless $result =~ m{\w} ;
    my $obj = decode_json $result ;
    return wantarray ? %$obj : $obj ;
    }

sub acl_add {
    my ( $self, $endpoint, $email, $rw ) = @_ ;
    my $readwrite = 'rw' ;
    $readwrite = 'r' unless $rw ;
    my $command
        = qq{acl-add $endpoint --identityusername=${email} --perm $readwrite }
        ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    my ($id) = reverse grep {m{\w}} split m{\s}, $result ;
    return $id ;
    }

sub acl_list {
    my ( $self, $endpoint ) = @_ ;
    my $command = qq{acl-list $endpoint} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    my $slist = decode_json $result ;
    my @list = grep { $_->{permissions} ne 'rw' } @$slist ;
    return wantarray ? @list : \@list ;
    }

sub acl_remove {
    my ( $self, $endpoint_uuid, $share_uuid ) = @_ ;
    my $command = qq{acl-remove $endpoint_uuid --id $share_uuid} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    return $result ;
    }

=head3 B<endpoint_add_shared>

=head3 B<endpoint_list>

=head3 B<endpoint_search>

=head3 B<endpoint_remove>

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

    # my $command
    #     = qq{endpoint-add --sharing "$sharer_endpoint$path" $endpoint } ;
    # my $command
    #     = qq{endpoint-add -n $endpoint --sharing "$sharer_endpoint$path" } ;
    my $command = join ' ',
        q{endpoint-add},
        q{--sharing}, "$sharer_endpoint$path",
        q{-n},        $endpoint,
        ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    return $result ;
    }

# sub endpoint_list {
#     my ( $self, $endpoint ) = @_ ;
#     my $command ;
#     if ($endpoint) {
#         $command = qq{endpoint-list $endpoint } ;
#         }
#     else {
#         $command = qq{endpoint-list} ;
#         }
#     my $result
#         = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
#     my @result = map { ( split m{\s}, $_ )[0] } split "\n", $result ;
#     return wantarray ? @result : \@result ;
#     }

#lists all my endpoint
sub endpoint_list {
    my ($self) = @_ ;
    my $command = 'endpoint-search --scope=my-endpoints' ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    my @result = map { s{\s}{}g ; $_ }
        map   { ( reverse split m{:} )[0] }
        grep  {m{Legacy}}
        split m{\n}, $result ;
    return wantarray ? @result : \@result ;
    }

sub endpoint_search {
    my ( $self, $search ) = @_ ;
    return {} unless $search ;
    my $command = qq{endpoint-search $search --scope=my-endpoints} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    my %result = map {
        chomp ;
        my ( $k, $v ) = split m{\s*:\s}, $_ ;
        $k => $v
        }
        split m{\n}, $result ;
    return wantarray ? %result : \%result ;
    }

sub list_my_endpoints {
    my ($self) = @_ ;
    my $command = 'endpoint-search --scope=my-endpoints' ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    my %result = map {
        my $hash ;
        %$hash = map {
            my ( $k, $v ) = split m{\s*:\s*} ;
            $k =~ s{\s+}{_}gmx ;
            $k = lc $k ;
            $k => $v
            }
            split m{\n} ;
        my $id

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

        }
        split m{\n\n}, $result ;
    return wantarray ? %result : \%result ;
    }

sub search_my_endpoints {
    my ( $self, $search ) = @_ ;
    my %result ;
    my $command = qq{endpoint-search $search --scope=my-endpoints} ;
    my $result
        = _globus_action( $command, $self->{username}, $self->{key_path} ) ;
    %result = map {
        my $hash ;
        %$hash = map {
            my ( $k, $v ) = split m{\s*:\s*} ;
            $k =~ s{\s+}{_}gmx ;
            $k = lc $k ;
            $k => $v
            }
            split m{\n} ;
        my $id

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

        $id => $hash ;
        }
        split m{\n\n}, $result ;
    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 ;
    }

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

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 ;