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::Prompter; 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 -in => \*STDIN, -out => \*STDOUT, $msg, -yn; } sub confirm_or_abort { my ($msg) = @_; $msg //= "Is this OK? [no will abort] "; my $confirmed = prompt -in => \*STDIN, -out => \*STDOUT, $msg, -yn; 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 -in => \*STDIN, -out => \*STDOUT, $msg; if ($is_username) { $email = fix_username($email); } unless (Email::Valid->address($email)) { undef $email; say "Error: 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 -in => \*STDIN, -out => \*STDOUT, $msg, -echo => '*'; if ($password ne '' and length $password < 12) { undef $password; say STDERR "Error: Passwords have to be at least 12 characters long."; } else { my $confirm = prompt -in => \*STDIN, -out => \*STDOUT, $msg2, -echo => '*'; unless ($password eq $confirm) { undef $password; say STDERR "Error: 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