App-SD
view release on metacpan or search on metacpan
0.75
The "this is getting ridiculous" release.
User-visible highlights (not all commits are listed here):
* fix hiveminder logins when setting username/password via URL (spang)
* bump dependencies to fix bitrot (spang, obra, franck)
* foreign replicas now have better username/password prompting (spang)
* clean up hiveminder sync messages (spang)
* fix cloning from hiveminder (spang)
* progress bar cleanups on clone/pull (spang)
* publish --html works again (sunnavy, spang)
* new server default port that clashes less with other HTTP servers (spang)
* misc mac fixes (obra, sunnavy)
* make -h more discoverable (spang)
* new 'help commands' page (spang)
* 'help browser' and 'help clone' now point to sync help (obra, spang)
* mention --as and --local in clone usage messages (spang)
* Add --version / -V - Christine Spang
* Now we can push attachments to trac! And we _test_ them - Jesse Vincent
* made "sd help attach" work - Jesse Vincent
* Fix push of comments to trac - Jesse Vincent
0.71
* Fix a broken regexp in manifest.skip which stopped SD on CPAN from having a pretty webui - thanks to Nelson Elhage
* Added documentation about proper clone command to use with a local sd server - Pedro Melo
* GitHub UI improvements and related updates for prompt_for_login API change - Christine Spang
* In the Redmine tests, we weren't doing all of our test skips in the BEGIN {} block. Marcus Ramberg caught this
* All help references for summary format should be 'ticket.summary-format' - Christine Spang
* bugfix: be able to delete props that aren't in common_ticket_props from the - Christine Spang
editor - Christine Spang
* Fix a help typo pointed out by Gerfried Fuchs - Christine Spang
* Further fixes/clarifications for search help. - Christine Spang
0.70 - 2009-08-26
inc/Module/AutoInstall.pm view on Meta::CPAN
}
elsif ( $arg =~ /^--test(?:only)?$/ ) {
$TestOnly = 1;
}
elsif ( $arg =~ /^--all(?:deps)?$/ ) {
$AllDeps = 1;
}
}
}
# overrides MakeMaker's prompt() to automatically accept the default choice
sub _prompt {
goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
my ( $prompt, $default ) = @_;
my $y = ( $default =~ /^[Yy]/ );
print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
print "$default\n";
return $default;
}
# the workhorse
sub import {
my $class = shift;
my @args = @_ or return;
my $core_all;
inc/Module/AutoInstall.pm view on Meta::CPAN
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
# We want to know if we're under CPAN early to avoid prompting, but
# if we aren't going to try and install anything anyway then skip the
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
$UnderCPAN = _check_lock(1) unless $SkipInstall;
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
my $default = 1;
my $conflict = 0;
inc/Module/AutoInstall.pm view on Meta::CPAN
next unless @required;
my $mandatory = ( $feature eq '-core' or $core_all );
if (
!$SkipInstall
and (
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
. ( $mandatory ? ' mandatory' : ' optional' )
. qq{ module(s) from CPAN?},
$default ? 'y' : 'n',
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
inc/Module/AutoInstall.pm view on Meta::CPAN
}
sub _update_to {
my $class = __PACKAGE__;
my $ver = shift;
return
if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
'y' ) =~ /^[Nn]/
)
{
die "*** Please install $class $ver manually.\n";
}
print << ".";
*** Trying to fetch it from CPAN...
.
inc/Module/AutoInstall.pm view on Meta::CPAN
*** Cannot bootstrap myself. :-( Installation terminated.
.
}
# check if we're connected to some host, using inet_aton
sub _connected_to {
my $site = shift;
return (
( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
qq(
*** Your host cannot resolve the domain name '$site', which
probably means the Internet connections are unavailable.
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/
);
}
# check if a directory is writable; may create it on demand
sub _can_write {
inc/Module/AutoInstall.pm view on Meta::CPAN
mkdir( $path, 0755 ) unless -e $path;
return 1 if -w $path;
print << ".";
*** You are not allowed to write to the directory '$path';
the installation may fail due to insufficient permissions.
.
if (
eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
qq(
==> Should we try to re-execute the autoinstall process with 'sudo'?),
((-t STDIN) ? 'y' : 'n')
) =~ /^[Yy]/
)
{
# try to bootstrap ourselves from sudo
print << ".";
*** Trying to re-execute the autoinstall process with 'sudo'...
inc/Module/AutoInstall.pm view on Meta::CPAN
return
unless system( 'sudo', $^X, $0, "--config=$config",
"--installdeps=$missing" );
print << ".";
*** The 'sudo' command exited with error! Resuming...
.
}
return _prompt(
qq(
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/;
}
# load a module and return the version it reports
sub _load {
my $mod = pop; # class/instance doesn't matter
my $file = $mod;
inc/Module/Install/Makefile.pm view on Meta::CPAN
BEGIN {
$VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub Makefile { $_[0] }
my %seen = ();
sub prompt {
shift;
# Infinite loop protection
my @c = caller();
if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
# In automated testing or non-interactive session, always use defaults
if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
goto &ExtUtils::MakeMaker::prompt;
}
}
# Store a cleaned up version of the MakeMaker version,
# since we need to behave differently in a variety of
# ways based on the MM version.
my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
# If we are passed a param, do a "newer than" comparison.
# Otherwise, just return the MakeMaker version.
lib/App/SD/CLI/Command/Clone.pm view on Meta::CPAN
};
sub usage_msg {
my $self = shift;
my $cmd = $self->cli->get_script_name;
return <<"END_USAGE";
usage: ${cmd}clone --from <url> [--as <alias>] [--non-interactive] | --local
Options:
-n | --non-interactive - Don't prompt to specify email address for new
database
--as - Save an alias for this source, which can later be
used instead of the URL.
--local - Probe the local network for mDNS-advertised
replicas and list them.
END_USAGE
}
override run => sub {
my $self = shift;
lib/App/SD/CLI/Command/Help/Sync.pm view on Meta::CPAN
${cmd}clone --from trac:https://trac.parrot.org/parrot
Cloning from GitHub
${cmd}clone --from github:miyagawa/remedie
SD uses LWP for HTTP access, so it supports any form of authentication
LWP can use. For instance, you can push and pull from a remote trac
that uses x509 client certificates by setting the HTTPS_CERT_FILE and
HTTPS_KEY_FILE environment variables, and specifying an empty password
when SD prompts you. For more information, see the documentation for
LWP and Crypt::SSLeay.
SD also supports naming replicas, so you can push, pull, and publish
to short, human-friendly names instead of URLs. When a replica is
initialized, cloned, or published, a [replica "name"] section is created in
the replica-specific configuration file (replica_root/config). Its name is, by
default, the URL you passed to the command. You can change this to a more
memorable name with:
${cmd}config edit
lib/App/SD/CLI/Command/Init.pm view on Meta::CPAN
with 'App::SD::CLI::NewReplicaCommand';
sub usage_msg {
my $self = shift;
my $cmd = $self->cli->get_script_name;
return <<"END_USAGE";
usage: ${cmd}init [--non-interactive]
Options:
-n | --non-interactive - Don't prompt to edit settings or specify email
address for new database
END_USAGE
}
sub ARG_TRANSLATIONS {
shift->SUPER::ARG_TRANSLATIONS(),
n => 'non-interactive',
};
override run => sub {
lib/App/SD/CLI/Command/Shell.pm view on Meta::CPAN
if ( !$self->app_handle->handle->replica_exists ) {
push @out, '', "No SD database was found at " . $self->app_handle->handle->url(),
'Type "help init" and "help environment" for tips on how to sort that out.';
}
return join( "\n", @out );
}
sub prompt {
my $self = shift;
return $self->project_name . "> ";
}
1;
lib/App/SD/CLI/NewReplicaCommand.pm view on Meta::CPAN
package App::SD::CLI::NewReplicaCommand;
use Any::Moose 'Role';
# steal email from $ENV{EMAIL} or prompt, and prompt to edit settings
sub new_replica_wizard {
my $self = shift;
my %args = (
edit_settings => 1,
@_,
);
# VCS wrappers themselves should take care of settings email addresses on
# init/clone from VCS configuration, don't put that here
# non-interactive option is useful for testing and scriptability
unless ( $self->has_arg('non-interactive') ) {
# don't prompt for configuration if there's already a user-wide email set
if ( ! defined $self->config->get( key => 'user.email-address' ) ) {
print "\nYou need an email address configured to use SD. I'll try"
." to find one.\n";
if ( $ENV{PROPHET_EMAIL} ) {
$self->_migrate_email_from_env( 'PROPHET_EMAIL' );
}
}
if ( ! defined $self->config->get( key => 'user.email-address' ) ) {
if ( $ENV{EMAIL} ) {
$self->_migrate_email_from_env( 'EMAIL' );
}
}
# if we still don't have an email, ask
if ( ! defined $self->config->get( key => 'user.email-address' ) ) {
$self->_prompt_email;
}
# new replicas probably want to change settings right away,
# at least to change the project name ;)
$self->_prompt_edit_settings if $args{edit_settings};
}
# this message won't print if the user has a ~/.sdrc, which is
# probably a pretty good indication that they're not new
my $script = $self->cli->get_script_name;
print <<"END_MSG" unless -f $self->config->user_file;
If you're new to SD, you can find out what to do now by looking at
'${script}help intro' and '${script}help tickets'. You can see a list of all
help topics with '${script}help'. Have fun!
END_MSG
}
# default is the replica-specific config file
sub _prompt_which_config_file {
my $self = shift;
my $email = shift;
print "\nUse '$email' for (a)ll your bug databases, (j)ust"
." this one,\nor (n)ot at all? [a/J/n] ";
chomp( my $response = <STDIN> );
my $config_file = lc $response eq 'a'
? $self->config->user_file
: lc $response eq 'n'
lib/App/SD/CLI/NewReplicaCommand.pm view on Meta::CPAN
: $self->config->replica_config_file;
return $config_file;
}
sub _migrate_email_from_env {
my $self = shift;
my $var = shift;
print "Found '$ENV{$var}' in \$$var.\n";
my $config_file = $self->_prompt_which_config_file( $ENV{$var} );
if ( $config_file ) {
$self->config->set(
key => 'user.email-address',
value => $ENV{$var},
filename => $config_file,
);
print " - added email '$ENV{$var}' to\n $config_file\n";
}
}
sub _prompt_email {
my $self = shift;
Prophet::CLI->end_pager(); # XXX where does this get turned back on?
print "\nCouldn't determine an email address to attribute your SD changes to.\n";
my $email;
while ( ! $email ) {
print "What email shall I use? ";
chomp( $email = <STDIN> );
}
my $use_dir_config = $self->prompt_choices( 'j', 'a',
'Use this for (a)ll your SD databases or (j)ust this one?' );
my $config_file = $use_dir_config
? $self->config->replica_config_file
: $self->config->user_file;
$self->config->set(
key => 'user.email-address',
value => $email,
filename => $config_file,
);
print " - added email '$email' to\n $config_file\n";
}
sub _prompt_edit_settings {
my $self = shift;
my $prompt_for_settings
= $self->prompt_Yn(
"\nWant to edit your new bug database's settings now?" );
if ( $prompt_for_settings ) {
my @classes = App::SD::CLI::Dispatcher->class_names('Settings');
for my $class (@classes) {
$self->app_handle->try_to_require($class) or next;
# reset args for new command
my $args = {
edit => 1,
};
$self->context->mutate_attributes( args => $args );
lib/App/SD/ForeignReplica.pm view on Meta::CPAN
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);
}
lib/App/SD/Replica/gcode/PushEncoder.pm view on Meta::CPAN
my $before_integration = time();
# grab any email/password that may have been specified in the --to url
my ( $email, $password ) = ($self->sync_source->gcode->email,
$self->sync_source->gcode->password);
($email, $password) = $self->sync_source->login_loop(
uri => 'gcode:' . $self->sync_source->project,
username => $email, password => $password,
# remind the user that gcode logins are email addresses
username_prompt => sub {
my $project = shift;
return "Login email for $project: ";
},
login_callback => sub {
my ($self, $email, $password) = @_;
# gcode.pm's BUILD has already been called, so we don't need to
# create the initial object, just specify auth
$self->gcode->email($email);
$self->gcode->password($email);
lib/App/SD/Replica/github.pm view on Meta::CPAN
my $config = Config::GitLike::Git->new;
$config->load;
$username = $config->get(key => 'github.user');
$api_token = $config->get(key => 'github.token');
}
($username, $api_token) = $self->login_loop(
uri => $uri,
username => $username,
password => $api_token,
secret_prompt => sub {
my ($uri, $username) = @_;
return "GitHub API token for $username (from ${uri}account): ";
},
login_callback => sub {
my ($self, $username, $api_token) = @_;
$self->github(
Net::GitHub->new(
login => $username,
token => $api_token,
lib/App/SD/Replica/hm.pm view on Meta::CPAN
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);
},
);
}
lib/App/SD/Replica/lighthouse.pm view on Meta::CPAN
if ( $auth =~ /@/ ) {
( $email, $password ) = split /:/, $auth;
}
else {
$token = $auth;
}
}
unless ( $token || $password ) {
if ($email) {
( undef, $password ) = $self->prompt_for_login(
uri => $server,
username => $email,
);
}
else {
( undef, $token ) = $self->prompt_for_login(
uri => $server,
username => 'not important',
secret_prompt => sub {
"token for $server: ";
}
);
}
}
$self->remote_url($server);
$self->account( $account );
$self->project( $project );
lib/App/SD/Replica/redmine.pm view on Meta::CPAN
my $uri = URI->new($server);
my ( $username, $password );
if ( my $auth = $uri->userinfo ) {
( $username, $password ) = split /:/, $auth, 2;
$uri->userinfo(undef);
}
$self->remote_url( $uri->as_string );
($username, $password)
= $self->prompt_for_login(
uri => $uri,
username => $username,
) unless $password;
$self->redmine(
Net::Redmine->new(
url => $self->remote_url,
user => $username,
password => $password
));
t/sd-usage.t view on Meta::CPAN
{
cmd => [ qw(browser -h) ],
error => [ 'usage: sd-usage.t browser [--port <number>]' ],
comment => 'browser usage',
},
{
cmd => [ qw(init -h) ],
error => [ 'usage: sd-usage.t init [--non-interactive]',
'',
'Options:',
" -n | --non-interactive - Don't prompt to edit settings or specify email",
' address for new database',
],
comment => 'init usage',
},
{
cmd => [ qw(clone -h) ],
error => [ 'usage: sd-usage.t clone --from <url> [--as <alias>] [--non-interactive] | --local',
'',
'Options:',
" -n | --non-interactive - Don't prompt to specify email address for new",
' database',
' --as - Save an alias for this source, which can later be',
' used instead of the URL.',
' --local - Probe the local network for mDNS-advertised',
' replicas and list them.',
],
comment => 'clone usage',
},
{
cmd => [ qw(-h) ],
( run in 0.876 second using v1.01-cache-2.11-cpan-0b5f733616e )