File Coverage

blib/lib/SugarSync/API.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

#! perl

package SugarSync::API;

use warnings;
use strict;
use v5.10;

use LWP::UserAgent;
use Carp;
use XML::Simple;
use Data::Dumper;

use constant APIURL  => 'https://api.sugarsync.com';

my $debug = 0;

=head1 NAME

SugarSync::API - Basic API to SugarSync cloud file sharing.

=cut

our $VERSION = '0.06';

=head1 SYNOPSIS

    use SugarSync::API;
    my $sushi = SugarSync::API->new( $username, $password );
    $sushi->get_userinfo;
    say "My SugarSync nickname is ", $sushi->{nickname};

Data structures are discussed in L.

=head1 METHODS

=head2 new [ username, password ]

Create a new API object.

If you pass a username and password, the object will be authorized.
Otherwise, an explicit call to the method C is required.

=cut

sub new {
    my ( $pkg, $user, $pass, $akeyid, $pacckey ) = @_;
    my $self = {};
    bless $self, $pkg;

    # Developer keys.
    # IMPORTANT: If you're going to develop your own application please
    # register with SugarSync and obtain your own access keys. Thanks.
    $self->{_akeyid}  = $akeyid  // 'NDA4Mzg1MTI3Mzk2NjIwMTYwNA';
    $self->{_pacckey} = $pacckey // 'ZjZlZmUyZmUyNjUwNGQ1NmJjOGMyOTA1YzljYjYyYTI';

    if ( defined($user) and defined($pass) ) {
	$self->get_auth( $user, $pass );
    }
    $self;
}

sub api_url {
    # Convenience: API url plus possible addition.
    my ( $self, $extra ) = @_;
    my $ret = APIURL;
    $ret .= "/" . $extra if $extra;
    $ret;
}

=head2 get_auth( username, password )

Get the authorization token for subsequent calls and stores it
internally to be used with other method calls.

Returns the authorization token.

=cut

sub get_auth {
    my ( $self, $username, $password ) = @_;

    # Use stored information if available.
    $username //= $self->{_authdata}->[0];
    $password //= $self->{_authdata}->[1];

    # Strictly speaking, we need to encode the fields into UTF-8.
    # Currently, assume ASCII...
    my $msg = <


    $username
    $password
    @{[ $self->{_akeyid} ]}
    @{[ $self->{_pacckey} ]}

EOD

    # Alternatively, use XML::Writer.
    # A bit overkill since this is the only piece of XML we'll need.
    # my $xml = XML::Writer->new( OUTPUT => \$msg );
    # $xml->startTag("authRequest");
    # $xml->dataElement( "username",         $username );
    # $xml->dataElement( "password",         $password );
    # $xml->dataElement( "accessKeyId",      AKEYID );
    # $xml->dataElement( "privateAccessKey", PACCKEY );
    # $xml->endTag("authRequest");
    # $xml->end;

    my $ua = LWP::UserAgent->new( agent => 'perl post' );
    my $res = $ua->post( $self->api_url('authorization'),
			 Content_Type => 'text/xml',
			 Content => $msg );

    # Returns "201 Created" upon success.
    Carp::croak( $res->error_as_HTML ) unless $res->is_success;
    warn( $res->as_string ) if $debug;
    my $loc = $1 if $res->as_string =~ /Location:\s+(.*)$/m;
    Carp::croak("Authentication failed") unless $loc;

    # Store information so we can re-authenticate when the token expires.
    # Currently, 1 hour.
    $self->{_authdata} = [ $username, $password ];

    # Store authentication token.
    $self->{_auth} = $loc;
}

=head2 get_userinfo

Retrieves the user info, e.g., quota, shared folders and so on.

=cut

sub get_userinfo {
    my ( $self ) = @_;
    $self->{userinfo} = 'xxx';	# prevent recursion
    my $ui = $self->get_url_xml( $self->api_url('user') );
    $self->{userinfo} = $ui;
    $self->{$_} = $ui->{$_}
      for qw(nickname username receivedShares syncfolders);
}

=head2 get_receivedShares

Returns the data for the shared folders.

=cut

sub get_receivedShares {
    my ( $self ) = @_;

    # Make sure we have user info.
    $self->get_userinfo unless $self->{userinfo};

    $self->{receivedShare} = $self->get_url_xml( $self->{receivedShares} )->{receivedShare};
}

=head2 get_receivedShare( $share )

Retrieves detailed information for a shared folder.

=cut

sub get_receivedShare {
    my ( $self, $share ) = @_;
    $self->get_url_xml($share);
}

=head2 get_files( $folder )

Retrieves the files data for a folder.

=cut

sub get_files {
    my ( $self, $folder ) = @_;
    my $res = $self->get_url_xml($folder);
    if ( $res->{hasMore} eq 'false' ) {
	return $res->{file};	# ????
    }
    else {
	croak("Files has more -- NYI");
    }
}

=head2 get_collections( $folder )

Retrieves the collections data for a folder.

=cut

sub get_collections {
    my ( $self, $folder ) = @_;
    my $res = $self->get_url_xml($folder);
    if ( $res->{hasMore} eq 'false' ) {
	return $res->{collection};
    }
    else {
	croak("Collection has more -- NYI");
    }
}

=head2 get_url_data( $url )

Retrieves the raw data for a given url.

Handles basic errors, like 401 (authentication token expired) and
temporary server failures.

=cut

my $error;

sub get_url_data {

    # Get the data for the url which must be valid XML.
    # This is the central query function.
    # Upon some other errors, it will retry.
    # Upon auth errors, it will try to re-authenticate.

    my ( $self, $url ) = @_;

    # Make sure we have user info.
    $self->get_userinfo unless $self->{userinfo};

    my $ua = LWP::UserAgent->new( agent => 'perl get' );
    $ua->default_header( 'Authorization', $self->{_auth} );

    my $res = $ua->get($url);
    unless ( $res->is_success ) {
	my $line = $res->status_line;
	if ( $line =~ /^(401)/ && $error++ < 10 ) {
	    # Authentication token expired.
	    warn("Reauth... ($line) #$error\n");
	    sleep( $error || 1 );
	    $self->get_auth;
	    return $self->get_url_data($url);
	}
	elsif ( $line =~ /^(50\d)/ && $error++ < 10 ) {
	    # Server unavailable of some sort.
	    warn("Retry... ($line) #$error\n");
	    sleep( $error || 1);
	    return $self->get_url_data($url);
	}
	Carp::croak( $line );
    }
    $error = 0;
    return $res->content;
}

=head2 get_url_xml( $url, $dump )

Retrieves the XML data for a given url and returns it as a Perl structure.

Optionally, dumps (using Data::Dumper) the structure to STDERR.

=cut

sub get_url_xml {

    # Get the data for the url which must be valid XML.
    # Return the XML data as a Perl structure.
    # Optionally, dump the structure for debugging.

    my ( $self, $url, $ddump ) = @_;

    local( $Data::Dumper::Indent ) = 1;

    my $res = XMLin( $self->get_url_data($url) );
    Carp::croak( "Not a HASH result: $res")
	unless UNIVERSAL::isa( $res, 'HASH' );
    warn Data::Dumper->Dump( [$res], [qw(xml_result)] ) if $ddump;

    # Make single-element list for lists.
    if ( keys(%$res) == 1 ) {
	my $k = (keys(%$res))[0];
	$res = { $k => [ $res->{$k} ] };
	warn Data::Dumper->Dump( [$res], [qw(xml_cooked)] ) if $ddump;
    }

    return $res;
}

use Time::Local;

sub ts_deparse {

    # Deparse a 2011-08-28T23:03:48.000-07:00 into a Unix epoch time.

    my ( $self, $ts ) = @_;
    Carp::croak("Invalid timestamp: $ts")
	unless $ts =~ /^(\d\d\d\d)-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d).(\d+)-(\d+):(\d+)$/;
    my $t = timegm( $6, $5, $4, $3, $2-1, $1 ) + 3600*$8 + 60*$9;
    #warn("$ts -> ".localtime($t)."\n");
    return $t;
}

1;

=SEE ALSO

L

=head1 AUTHOR

Johan Vromans, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C
rt.cpan.org>, or through the web interface at
L. I
will be notified, and then you'll automatically be notified of
progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SugarSync::API
    perldoc SugarSync::API::Data

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

Thanks to Mark Willis for producing a non-functional php module.

=head1 COPYRIGHT & LICENSE

Copyright 2011 Johan Vromans, all rights reserved.

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

=cut

1;