package Fripost::Prompt; use 5.010_000; use strict; =head1 NAME Prompt.pm - Lots of prompt helper functions =cut our $VERSION = '0.01'; use Data::Dumper; use Email::Valid; use Exporter; use IO::Prompt; use Fripost::Password qw/mkpasswd/; our @EXPORT = qw(confirm confirm_or_abort fix_username prompt_email prompt_password); our @ISA = qw(Exporter); sub confirm { my ($msg) = @_; $msg //= "Is this OK? [no will abort] "; return prompt $msg, -ynt; } sub confirm_or_abort { my ($msg) = @_; $msg //= "Is this OK? [no will abort] "; my $confirmed = prompt $msg, -ynt; unless ($confirmed) { say "User aborted"; exit 1; } } sub fix_username { my ($nam) = @_; if (defined $nam && $nam !~ /\@/) { $nam .= '@fripost.org'; say "Using $nam"; } return $nam; } sub prompt_email { my ($msg, $is_username) = @_; $msg //= "Enter email: "; my $email; do { $email = prompt $msg; if ($is_username) { $email = fix_username($email); } unless (Email::Valid->address($email)) { undef $email; say "This is not a valid e-mail address. Try again." } } until (defined $email); return $email; } sub prompt_password { my ($msg, $msg2) = @_; $msg //= "Enter new password (blank for random): "; $msg2 //= "Enter new password again (blank for random): "; my $password; do { $password = prompt $msg, -e => '*'; my $confirm = prompt $msg2, -e => '*'; unless ($password eq $confirm) { undef $password; say "Passwords do not match"; } } until (defined $password); if ($password eq '') { $password = mkpasswd(); say "Using password: $password"; } return $password; } =head1 AUTHOR Stefan Kangas C<< >> =head1 COPYRIGHT Copyright 2010,2011 Stefan Kangas. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as perl itself. =cut 1; # End of Prompt.pm