File Coverage

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

Criterion	Covered	Total	%
statement	12	67	17.9
branch	0	22	0.0
condition	0	6	0.0
subroutine	4	15	26.6
pod	8	8	100.0
total	24	118	20.3

#######################################################################
# ex: set ts=8 sw=4 et
#########################################################################
package WWW::Facebook::API::Auth;

use warnings;
use strict;
use Carp;

use Readonly;
Readonly my $DEFAULT_SLEEP => 15;

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 WFA 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 Facebook app
    system qq($browser "$url");

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

    return $token;
}

sub expire_session {
    my $self = shift;
    return $self->base->call('auth.expireSession',
            session_key => $self->base->session_key, @_);
}

sub promote_session {
    my $self = shift;
    return $self->base->call( 'auth.promoteSession',
            session_key => $self->base->session_key, @_ );
}

sub revoke_authorization {
    return shift->base->call( 'auth.revokeAuthorization', @_ );
}

sub revoke_extended_permission {
    return shift->base->call( 'auth.revokeExtendedPermission', @_ );
}

sub logout {
    my $self = shift;
    $self->base->ua->post( 'http://www.facebook.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__