File Coverage

blib/lib/WWW/Bebo/API/Auth.pm

Criterion	Covered	Total	%
statement	12	61	19.6
branch	0	22	0.0
condition	0	5	0.0
subroutine	4	11	36.3
pod	4	4	100.0
total	20	103	19.4

#######################################################################
# $Date$
# $Revision$
# $Author$
# ex: set ts=8 sw=4 et
#########################################################################
package WWW::Bebo::API::Auth;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.0.03');

sub create_token {
    my $self = shift;
    my $token;
    my ( $format, $parse ) = ( $self->base->format, $self->base->parse );

    $self->base->format('JSON');
    $self->base->parse(0);

    $token = $self->base->call( 'auth.createToken', @_ );
    $token =~ s/\W//xmsg;

    $self->base->format($format);
    $self->base->parse($parse);

    return $token;
}

sub get_session {
    my $self = shift;

    my $token = shift;
    croak q{Token needed for call to get_session} if not defined $token;

    # Mappings between the response fields and the WBA fields
    my %field = qw(
        session_key     session_key
        expires         session_expires
        uid             session_uid
        secret          secret
    );

    # Desktop apps need to call the https rather than http endpoint
    $self->_use_https_uri() if $self->base->desktop;

    # Save format and parse settings, and get parsed response from server
    my ( $format, $parse ) = ( $self->base->format, $self->base->parse );
    $self->base->format('JSON');
    $self->base->parse(1);
    my $resp = $self->base->call( 'auth.getSession', auth_token => $token );
    $self->base->format($format);
    $self->base->parse($parse);

    $self->_use_http_uri() if $self->base->desktop;

    # Copy values from response to object's hash
AUTH_RESPONSE:
    for my $key ( keys %{$resp} ) {
        next AUTH_RESPONSE if $key eq 'secret' && !$self->base->desktop;
        carp "Setting $field{$key}: $resp->{$key}" if $self->base->debug;
        $self->base->{ $field{$key} } = $resp->{$key};
    }

    return;
}

sub login {
    my ( $self, %args ) = @_;

    croak q{Cannot use login method with web app} unless $self->base->desktop;

    my $token = $self->create_token;
    my $url = $self->base->get_login_url( auth_token => $token );
    my $browser =
          $args{'browser'}
        ? $args{'browser'}
        : $^O =~ m/darwin/xms ? 'open'     ## no critic
        : $^O =~ m/MSWin/xms  ? 'start'    ## no critic
        :                       q{};

    croak "Don't know how to open browser for system '$^O'" if not $browser;

    # Open browser have user login to Bebo app
    system qq($browser "$url");

    # Give the user time to log in
    $args{'sleep'} ||= 15;
    sleep $args{'sleep'};

    return $token;
}

sub logout {
    my $self = shift;
    $self->base->ua->post( 'http://www.bebo.com/logout.php',
        { confirm => 1 } );
    return;
}

sub _use_http_uri  { return shift->_flip_scheme(0); }    ## no critic
sub _use_https_uri { return shift->_flip_scheme(1); }    ## no critic

sub _flip_scheme {
    my $self       = shift;
    my $make_https = shift;
    my $scheme     = $make_https ? 'http' : 'https';

    ( my $uri = $self->base->server_uri() ) =~ s{^[^:]+:}{$scheme:}xms;
    $self->base->server_uri($uri);

    return;
}

1;
__END__