File Coverage

blib/lib/WebService/Freesound.pm

Criterion	Covered	Total	%
statement	167	188	88.8
branch	38	56	67.8
condition	17	30	56.6
subroutine	23	24	95.8
pod	15	15	100.0
total	260	313	83.0

package WebService::Freesound;
use strict;
use warnings;

use 5.008;

use LWP::Simple;
use LWP::UserAgent;
use Carp;

use JSON qw(decode_json);

# Freesound.org urls.
#
our %urls = (
    'base'         => 'https://www.freesound.org/apiv2',
    'code'         => '/oauth2/authorize/',
    'access_token' => '/oauth2/access_token/',
    'search'       => '/search/text/?',
    'download'     => '/sounds/_ID_/download/',
    'me'           => '/me/',
);

=pod

=head1 NAME

WebService::Freesound - Perl wrapper around Freesound OAuth2 API!

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

    #!/usr/bin/perl
    use WebService::Freesound;

    my %args = (
       client_id     => '03bbed9a541baf763526',
       client_secret => 'abcde1234598765fedcba78629091899aef32101',
       session_file  => '/var/www/myapp/freesoundrc',
    );

    my $freesound = WebService::Freesound->new (%args);

    # Freesound 3-Step OAuth process:
    #
    # Step 1.
    # Get authorisation URL
    #
    my $authorization_url = $freesound->get_authorization_url();

    # Step 2.
    # Redirect the user to authorization url, or paste into browser.
    # Or pop up an  with this URL as src. </td>
</tr>

<tr>
<td  class="h" >
<a name="61">61</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     # </td>
</tr>

<tr>
<td  class="h" >
<a name="62">62</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     use CGI; </td>
</tr>

<tr>
<td  class="h" >
<a name="63">63</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     my $q = new CGI; </td>
</tr>

<tr>
<td  class="h" >
<a name="64">64</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     $q->redirect($authorization_url); </td>
</tr>

<tr>
<td  class="h" >
<a name="65">65</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> &nbsp; </td>
</tr>

<tr>
<td  class="h" >
<a name="66">66</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     # OR in Toolkit::Template : Will put the Freesound.org's authentication </td>
</tr>

<tr>
<td  class="h" >
<a name="67">67</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     # window on your site, with Approve or Deny buttons. </td>
</tr>

<tr>
<td  class="h" >
<a name="68">68</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     # </td>
</tr>

<tr>
<td  class="h" >
<a name="69">69</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     <iframe src=[% authorization_url %]>No iframe support

    # Step 3.
    # A 'code' will be made available from the authorization_url from Freesound.
    # Use it here to get access_token, refresh_token and expiry times. These are
    # stored internally to the object and on disk. In theory, you should not need
    # to see them, but are accessible via their respective accessors.
    #
    my $rc = $freesound->get_new_oauth_tokens ($code));
    if ($rc) {
       print $freesound->error;
    }

    # At any time you can call check_authority to see if you are still authorised,
    # and this will return 1 or undef/$freesound->error.  It will refresh the tokens
    # if refresh_if_expired is set.
    #
    my $rc = $freesound->check_authority (refresh_if_expired => 1/undef);
    if ($rc) {
       print $freesound->error;
    }

    # All done with OAuth2 now it ..should.. just work forever (or until you revoke
    # the authorization at L, when
    # logged in, or set refresh_if_expired to undef).
    #
    # Get Freesound data, see L
    # Returns a L or undef and $freesound->error.
    #
    my $rc = $freesound->check_authority (refresh_if_expired => 1);
    if ($rc) {
       my $response = $freesound->query ("query..." or "filter..." etc) # no query question mark required.
    }

    # Download the sample from a Freesound id into the specified directory with a
    # progress update in counter_file - for web apps get javascript to fire an Ajax call
    # to read this file until 100% complete.  Returns the path to the sample or undef
    # and $freesound->error.
    #
    my $rc = $freesound->check_authority (refresh_if_expired => 1);
    if ($rc) {
       my $file = $freesound->download ($id, '/var/www/myapp/downloads/', $counter_file);
    }

=head1 DESCRIPTION

This module provides a Perl wrapper around the L RESTful API.

Freesound is a collaborative database of Creative Commons Licensed sounds. It allows
you to browse, download and share sounds.  This Perl wrapper at present allows you
'read-only' access to Freesound, ie browse and download.  Upcoming versions could provide
upload, describe and edit your own sounds (though I expect it might just be easier to use
their website for this).

The complete Freesound API is documented at L

In order to use this Perl module you will need get an account at Freesound
(L) and then to register your application with them
at L. Your application will then be given a client ID and
a client secret which you will need to use to get OAuth2 authorisation.

The OAuth2 Dance is described at Freesound, L
and officially at L.  It is a three step process as
suggested above.

This module should look after the authorisation once done, ie when the expiry time arrives
it can automatically refresh the tokens.  The auth tokens are therefore kept as a file specified by
"I", which should be read-only by you/www-data only.

When downloading a sound sample from Freesound a progress meter is available in "I"
which is useful in web contexts as a progress bar.  Format of the file is :

::
# for example "10943051:12578220:87", ie 87% of 12578220 bytes written.

This is optional.

Also the download will download the sample file as its name and type suffix (some Freesound names have
suffixes, some don't), so something like "/var/www/myapp/downloads/Pretty tune on piano.wav",
".../violin tremolo G5.aif" etc.

The query method allows you to put any text string into its parameter so that you have the full
capabilities of Freesound search, filter, sort etc, as described here :
L

If used as part of a web app, then the process could be :

=over 4

=item * Check for I. If none then put up an iframe with the src set to output
of C<$freesound->get_authorization_url();>

=item * User clicks Authorise with a callback run (set in Freesound API credentials :
L (ie http://localhost/cgi-bin/mayapp/do_auth.cgi)
which calls C<$freesound->get_oauth_tokens ($code))> - the code will be a parameter in
the CGI (ie C<$q->param ('code')>).

=item * Text search box on main webpage can then be used as inputs to C<$freesound->query> -
the output formatted into HTML (from XML or json) as you
wish.  With Freesound you get a picture of the waveform and a low quality sound preview so you can engineer
your website to show the waveform and have start/stop/pause buttons.  Best not to replicate the entire
Freesound website, as this might contravene their terms and conditions.

=item * A Freesound sample will have an id. This can be used in C<$freesound->download ($id, $dir, $counter_file)>.

=item * Show download progress bar by continually polling the contents
of I (with an Ajax call) and drawing a CSS bar.  Actually downloads to your server, not the
web-browser users Downloads directory.

=back

=head2 METHODS

=over 4

=item new ( I, I and I )

Creates a new Freesound object for authorisation, queries and downloads.
I, I and I are required.

=cut

sub new {
    my ( $class, %args ) = @_;
    my $self = bless {}, $class;

    $self->{client_id} = $args{client_id}
        || croak('client_id is required');
    $self->{client_secret} = $args{client_secret}
        || croak('client_secret is required');
    $self->{session_file} = $args{session_file}
        || croak('session_file is required');

    # State.
    #
    $self->{ua}            = LWP::UserAgent->new();
    $self->{error}         = "";
    $self->{access_token}  = "";
    $self->{refresh_token} = "";
    $self->{expires_in}    = "";

    return $self;
}

=item client_id

Accessor for the Client ID that was provided when you registered your
application with Freesound.org.

=cut

sub client_id {
    my ( $self, $client_id ) = @_;

    if ( defined $client_id ) {
        $self->{client_id} = $client_id;
    }

    return $self->{client_id};
}

=item client_secret

Accessor for the client secret that was provided when you registered your
application with Freesound.org.

=cut

sub client_secret {
    my ( $self, $client_secret ) = @_;

    if ( defined $client_secret ) {
        $self->{client_secret} = $client_secret;
    }

    return $self->{client_secret};
}

=item session_file

Accessor for the session file that stores the authorisation codes.

=cut

sub session_file {
    my ( $self, $session_file ) = @_;

    if ( defined $session_file ) {
        $self->{session_file} = $session_file;
    }

    return $self->{session_file};
}

=item ua

Accessor for the User Agent.

=cut

sub ua {
    my ( $self, $ua ) = @_;

    if ( defined $ua ) {
        $self->{ua} = $ua;
    }

    return $self->{ua};
}

=item error

Accessor for the error messages that may occur.

=cut

sub error {
    my ( $self, $error ) = @_;

    if ( defined $error ) {
        $self->{error} = $error;
    }

    return $self->{error};
}

=item access_token

Accessor for the OAuth2 access_token.

=cut

sub access_token {
    my ( $self, $access_token ) = @_;

    if ( defined $access_token ) {
        $self->{access_token} = $access_token;
    }

    return $self->{access_token};
}

=item refresh_token

Accessor for the OAuth2 refresh_token.

=cut

sub refresh_token {
    my ( $self, $refresh_token ) = @_;

    if ( defined $refresh_token ) {
        $self->{refresh_token} = $refresh_token;
    }

    return $self->{refresh_token};
}

=item expires_in

Accessor for the OAuth2 expiry time.

=cut

sub expires_in {
    my ( $self, $expires_in ) = @_;

    if ( defined $expires_in ) {
        $self->{expires_in} = $expires_in;
    }

    return $self->{expires_in};
}

=item get_authorization_url

This returns the URL to start with when no auth is offered or accepted. Use it in an
iframe if using this in a CGI environment (ie send to L).

=cut

sub get_authorization_url {
    my $self = shift;
    my $auth_url
        = $urls{'base'}
        . $urls{'code'}
        . '?client_id='
        . $self->client_id
        . '&response_type=code'
        . '&state=xyz';
    return $auth_url;
}

=item get_new_oauth_tokens ( I )

Takes the resultant 'code' displayed when the user authorises this app on Freesound.org and
then sets the internal OAuth tokens, along with expiry time.  This method seriailises
this in the session_file for later use.  This is Step 3 in the process as described in
L.
Returns 1 if succesful, undef and $freesound->error if not.

=cut

sub get_new_oauth_tokens {

    my $self = shift;
    my $code = shift || croak "Need the code from Freesound authorisation";
    my $rc   = 1;
    $self->error("");

    my $url  = $urls{'base'} . $urls{'access_token'};
    my %form = (
        client_id     => $self->client_id,
        client_secret => $self->client_secret,
        grant_type    => 'authorization_code',
        code          => $code,
    );
    $rc = $self->_post_request( $url, \%form );

    return $rc;
}

=item check_authority

Checks the session file exists, has a current token.  If no session file, then
returns URI to get the initial code from. If session file exists and and has not
expired then it checks with Freesound.org for existing authority.  If the tokens
need refreshing and refresh_if_expired is set, it attempts a refresh.  If that's
successful, then updates the session file with new oauth tokens.  Return error if
the refresh didn't work (or refreshable but not asked to) - maybe because the
authority has been revoked.  See L
when logged into Freesound.org.  Return error if there is no authorisation at
Freesound.org.

=cut

sub check_authority {

    my $self = shift;
    my %args = (
        refresh_if_expired => undef,
        @_
    );
    $self->error("");
    my $rc = 1;

    # Check file exists.
    #
    if ( -s $self->session_file ) {

        # Read the session file and get its json auth tokens.
        #
        open my $fh, '<', $self->session_file
            or croak
            "Cannot read provided session_file for reading, though it does exist : $!";
        my $oauth_tokens_string = "";
        while ( my $line = <$fh> ) {
            $oauth_tokens_string .= $line;
        }
        close $fh;

        my $oauth_tokens;
        eval { $oauth_tokens = decode_json($oauth_tokens_string); };

        if ($oauth_tokens) {

            # Load them into the object for use when getting
            # anything from Freesound. Encapsulate.
            #
            foreach ( keys %$oauth_tokens ) {
                $self->{$_} = $oauth_tokens->{$_};
            }

            # Check expiry by file timestamp, expires_in and now.
            #
            my $timestamp = ( stat( $self->session_file ) )[9];
            my $expired;
            $expired++
                if ( ( $timestamp + $oauth_tokens->{'expires_in'} ) < time );

            if ( defined $args{'refresh_if_expired'} && $expired ) {

                # Expired, refresh tokens.
                #
                my $url  = $urls{'base'} . $urls{'access_token'};
                my %form = (
                    client_id     => $self->client_id,
                    client_secret => $self->client_secret,
                    grant_type    => 'refresh_token',
                    refresh_token => $oauth_tokens->{'refresh_token'},
                );

                # $freesound->error will be filled in if an error.
                #
                unless ( $self->_post_request( $url, \%form ) ) {
                    $rc = undef;
                }

            }
            elsif ($expired) {
                $rc = undef;
                $self->error("Authority has expired");
            }
        }
        else {
            $self->error(
                "OAuth tokens from the specified session_file appears to be not JSON"
            );
            $rc = undef;
        }
    }
    else {

        # No session file,
        #
        $self->error( 'Need to re-authorise with Freesound, '
                . 'use get_authorization_url then get_oauth_tokens '
                . 'with the returned code from Freesound' );
        $rc = undef;
    }

    # Finally, if we're all ok our end, check with Freesound.org.
    #
    if ($rc) {
        my $url         = $urls{'base'} . $urls{'me'};
        my $auth_String = "Bearer " . $self->access_token;
        $self->ua->default_header( 'Authorization' => "$auth_String" );
        my $response = $self->ua->get($url);
        unless ( $response->is_success ) {
            $rc = undef;
            $self->error(
                "Not authorised with Freesound : " . $response->status_line );
        }

    }
    return $rc;
}

=item query ( I )

Does the querying of the Freesound database, see
L
Should just let any string go into the query like filter, tag, sort, geotag etc.  Just a string.
Returns whatever Freesound returns in an L.

=cut

sub query {

    my $self = shift;
    my $query = shift || croak "Need a Freesound query string";
    $self->error("");

    my $auth_String = "Bearer " . $self->access_token;
    $self->ua->default_header( 'Authorization' => "$auth_String" );
    my $url      = $urls{'base'} . $urls{'search'} . $query;
    my $response = $self->ua->get($url);
    $self->error( $response->status_line ) unless $response->is_success;
    return $response;
}

=item download ( I, I, {I} )

The I is unique to a sample on Freesound, use C<$freesound->query>. The I
is where the downloaded file should go, the actual sound file will be named after its name on Freesound
and will have the correct extension (wav, mp3, aif etc).  The I is optional - it keeps
a running count of the download progress .  In a web environment a Javascript Ajax call can read
this in real-time to give a progress bar.  I probably needs to be named with a session id
of some sort. Returns the path of the file or undef (then see C<$freesound->error>).

=cut

sub download {
    my $self = shift;
    my $id   = shift || croak "download needs a Freesound id";
    my $to   = shift || croak "download needs a destination directory id";
    my $counter_file = shift;
    my $rc           = 1;
    $self->error("");

    # Download needs OAuth.
    #
    $self->ua->default_header(
        'Authorization' => 'Bearer ' . $self->access_token );

    # Download url has an ID in the midle of it.
    #
    my $url = $urls{'base'} . $urls{'download'};
    $url =~ s/_ID_/$id/;

    # Get the name of the sample (ie BASS01.wav) from Freesound.org.
    #
    my $filename
        = $self->get_filename_from_id($id);    # error to $freesound->error

    my $fqp;
    if ($filename) {

        open my $download_fh, '>', "$to/$filename"
            or croak "Cannot open $filename for writing : $!";

        # Use a callback sub to keep count of the number of bytes
        # written to the sample file, in a counter file.
        #
        my $received_size = 0;
        my $response      = $self->ua->get(
            $url,
            ':read_size_hint' => 8192,
            ':content_cb'     => sub {

                # This is handily provided by User::Agent in the callback.
                #
                my ( $data, $response, $protocol ) = @_;

                # Write this chunk of data to the download file.
                #
                print $download_fh $data;

                # Ony actually update download progress if requested.
                #
                if ( defined $counter_file ) {

                    # Calculate progress.
                    #
                    my $total_size = $response->header('Content-Length');
                    $received_size += length $data;
                    my $percentage_complete = sprintf( "%d",
                        ( $received_size / $total_size ) * 100 );

                    # Progress bar info : "10943051:12578220:87",
                    # ie 87% of 12578220 bytes written.
                    #
                    open my $counter_fh, '>', $counter_file
                        or croak "Cannot open $counter_file for writing : $!";
                    print $counter_fh
                        "$received_size:$total_size:$percentage_complete";
                    close $counter_fh;
                }
            }
        );
        close $download_fh;
        $fqp = $to . '/' . $filename;
    }
    return $fqp;
}

=item get_filename_from_id ( I )

Does a query to get two fields - name and type (wav, mp3, aif etc) from the Freesound I of the sample.
Returns undef and $freesound->error if can't find a name/type for this id.

=cut

sub get_filename_from_id {

    my $self = shift;
    my $id   = shift;
    $self->error("");

    # Query Freesound for the filename from its id, return name and type
    # in json.
    #
    my $response = $self->query("filter=id:$id&fields=name,type&format=json");

    my $filename;
    my $type;
    if ( $response->is_success ) {

        my $details;
        eval { $details = decode_json( $response->decoded_content ); };

        # {
        #   'count' => 1,
        #   'results' => [
        #                  {
        #                    'type' => 'wav',
        #                    'name' => 'bass 16b.wav'
        #                  }
        #                ],
        #   'previous' => undef,
        #   'next' => undef
        # };
        if (   defined $details
            && defined $details->{'results'}->[0]->{'name'}
            && defined $details->{'results'}->[0]->{'type'} )
        {

            my $name = $details->{'results'}->[0]->{'name'};
            my $type = $details->{'results'}->[0]->{'type'};

            # Could be "bass 16b.mp3.wav" if user hasn't named it
            # properly.
            #
            $filename = "$name.$type";

            # Override if extension is actually correct.
            #
            $filename = $name if $name =~ /\.$type\s*$/;

        }
        else {
            $self->error("Cannot find a name or type for Freesound id $id");
        }

    }
    else {
        $self->error( $response->status_line );
    }
    return $filename;
}

=back

=head1 INTERNAL SUBROUTINES/METHODS

Please don't use these as they may change on a whim.

=over 4

=item _post_request

Updates the objects oauth tokens and session file from User Agent response. Returns
1 or undef and $freesound->error.

=cut

sub _post_request {

    my $self      = shift;
    my $url       = shift;
    my $post_args = shift;
    my $rc        = 1;
    $self->error("");

    my $response = $self->ua->post( $url, $post_args );

    if ( $response->is_success ) {

        my $oauth_tokens_string = $response->decoded_content;

        # Extract the data into the object and save it too.
        #
        #   "access_token", "token_type", "Bearer", "expires_in",
        #   "refresh_token", "scope"
        #
        my $oauth_tokens;
        eval { $oauth_tokens = decode_json($oauth_tokens_string) };

        # todo - need to use JSON properly.

        if ($oauth_tokens) {

            # Save to session_file.
            #
            open my $counter_fh, '>', $self->session_file
                or croak "Cannot open provided session_file for writing : $!";
            print $counter_fh $oauth_tokens_string;
            close $counter_fh;

            # Encapsulate.
            #
            foreach ( keys %$oauth_tokens ) {
                $self->{$_} = $oauth_tokens->{$_};
            }

        }
        else {
            $self->error("Response from user agent appears not to be JSON");
            $rc = undef;
        }

    }
    else {
        $self->error( $response->status_line );
        $rc = undef;
    }
    return $rc;

}

=back

=head1 AUTHOR

Andy Cragg, C<<  >>

=head1 BUGS

This is beta code and may contain bugs - please feel free to fix them and send patches.

=head1 SUPPORT

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

    perldoc WebService::Freesound

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

I had a look at L by Mohan Prasad Gutta, L for some ideas.

=head1 LICENSE AND COPYRIGHT

Copyright 2016 Andy Cragg.

This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:

L

Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.

If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.

This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.

This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.

Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


=cut

1;    # End of WebService::Freesound