view release on metacpan or  search on metacpan

lib/App/SD/ForeignReplica.pm  view on Meta::CPAN

    my $self = shift;
    my %args = validate(
        @_,
        {   uuid      => 1,
            remote_id => 1
        }
    );
    $self->_set_uuid_for_remote_id(%args);
    $self->_set_remote_id_for_uuid(%args);
}

sub record_upstream_last_modified_date {
    my $self = shift;
    my $date = shift;
    return $self->store_local_metadata('last_modified_date' => $date);
}

sub upstream_last_modified_date {
    my $self = shift;
    return $self->fetch_local_metadata('last_modified_date');
}

=head2 login_loop

Loop on prompting for username/password until login is successful; user can
abort with ^C.

Saves username and password to the replica's configuration file
upon successful login.

params:
- uri             # login url
- username        # optional; a pre-seeded username
- password        # optional; a pre-seeded password
- username_prompt # optional; custom username prompt
- secret_prompt   # optional; custom secret prompt
- login_callback  # coderef of code that attempts login; should throw exception
                  # on error
- catch_callback  # optional; process thrown exception message (e.g. munge
                  # in some way and then print to STDERR)

returns: ($username, $password)

=cut

sub login_loop {
    my $self = shift;
    my %args = @_;

    my $login_successful = 0;
    my ($username, $password);

    my %login_args = ( uri => $args{uri}, username => $username );
    $login_args{username_prompt} = $args{username_prompt}
        if $args{username_prompt};
    $login_args{secret_prompt} = $args{secret_prompt}
        if $args{secret_prompt};
    # allow prompting for just password if username already specified
    # and vice-versa for password
    # if both are specified, we still want to loop in case the
    # credentials are wrong
    $login_args{username} = $args{username} if $args{username};
    $login_args{password} = $args{password} if $args{password};

    while (!$login_successful) {
        ( $username, $password ) = $self->prompt_for_login(%login_args);

        try {
            $args{login_callback}->($self, $username, $password);
            $login_successful = 1;
        } catch {
            if ($args{catch_callback}) {
                $args{catch_callback}->($_);
            }
            else {
                warn "\n$_\n\n";
            }
            # in the case of a failed login, reset username/password
            # to nothing so we re-prompt for both in the case of
            # having used saved values
            ($login_args{username}, $login_args{password}) = (undef, undef);
        };
        $self->foreign_username($username) if ($username);
    }
    # only save username/password if login was successful
    $self->save_username_and_token( $username, $password );

    return ($username, $password);
}

=head2 extract_auth_from_uri( $uri_string )

Given a server URI string, possibly containing auth info, extract the
auth info if it exists.

Also sets the remote_url and url attribute to the server URI with the auth
information removed.

returns: ($username, $password)

=cut

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

    my $uri = URI->new($uri_string);
    my ($username, $password);

    if ( $uri->can('userinfo') && ( my $auth = $uri->userinfo ) ) {
        ( $username, $password ) = split /:/, $auth, 2;
        $uri->userinfo(undef);
    }
    $self->remote_url("$uri");
    $self->url("$uri");

    return ($username, $password);
}

sub foreign_username {
    die "replica class must implement foreign_username";
}