view release on metacpan or  search on metacpan

lib/App/SD/Replica/hm.pm  view on Meta::CPAN

use Any::Moose;
extends 'App::SD::ForeignReplica';
use Params::Validate qw(:all);
use Memoize;
use Prophet::ChangeSet;
use File::Temp 'tempdir';
use Carp;
use Try::Tiny;

has hm               => ( isa => 'Net::Jifty', is => 'rw' );
has remote_url       => ( isa => 'Str',        is => 'rw' );
has foreign_username => ( isa => 'Str',        is => 'rw' );
has props            => ( isa => 'HashRef',    is => 'rw' );

use constant scheme       => 'hm';
use constant pull_encoder => 'App::SD::Replica::hm::PullEncoder';
use constant push_encoder => 'App::SD::Replica::hm::PushEncoder';

# XXX TODO - kill the query requirement by refactoring sub run in the superclass
use constant query => '';

=head2 BUILD

Open a connection to the source identified by C<$self->{url}>.

=cut

# XXX: this should be called from superclass, or better, have individual attributes have their own builders.

sub BUILD {
    my $self = shift;

    # Require rather than use to defer load
    try {
        require Net::Jifty;
    } catch {
        die "SD requires Net::Jifty to sync with a Hiveminder server.\n".
        "'cpan Net::Jifty' may sort this out for you";
    };

    my ( $server, $props ) = $self->{url} =~ m/^hm:(.*?)(?:\|(.*))?$/
        or die
        "Can't parse Hiveminder server spec. Expected hm:http://hiveminder.com or hm:http://hiveminder.com|props";

    my ($username, $password) = $self->extract_auth_from_uri($server);

    if ( $password ) {
        try {
            $self->_hiveminder_login($username, $password);
        } catch {
            die "Bad username or password specified in URL! ".
                "Error message was:\n".
                _hiveminder_clean_login_error($_);
        };
    }
    else {
        ($username, $password) = $self->login_loop(
            uri      => $self->remote_url,
            username => $username,
            # remind the user that hiveminder logins are email addresses
            username_prompt => sub {
                my $uri = shift;
                return "Login email for $uri: ";
            },
            login_callback => \&_hiveminder_login,
            catch_callback => sub {
                my ($verbose_error) = @_;
                warn _hiveminder_clean_login_error($verbose_error);
            },
        );
    }
    $self->foreign_username($username);

    if ($props) {
        my %props = split /=|;/, $props;
        $self->props( \%props );
    }
}

sub _hiveminder_login {
    my ($self, $username, $password) = @_;
    $self->hm(
        Net::Jifty->new(
            site        => $self->remote_url,
            cookie_name => 'JIFTY_SID_HIVEMINDER',
            email    => $username,
            password => $password
        )
    );
}

sub _hiveminder_clean_login_error {
    my $verbose_error = shift;
    # Net::Jifty uses Carp::confess to deal with login problems :(
    my $error_message = (split /\n/, $verbose_error)[0];
    $error_message =~ s/ at .* line [0-9]+$//;
    return "\n$error_message\n\n";
}

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

    return defined($response->{success}) && $response->{success} == 0;
}

sub decode_error {
    my $self   = shift;
    my $status = shift;
    my $msg    = '';
    $msg .= $status->{'error'} if defined $status->{'error'};
    if ( $status->{'field_errors'} ) {
        while ( my ( $k, $v ) = each %{ $status->{'field_errors'} } ) {
            $msg .= "field '$k' - '$v'\n";
        }
    }
    return $msg;
}

=head2 _uuid_url

Return the replica's UUID