view release on metacpan or  search on metacpan

usr/share/webapp-toolkit/extra/class/admin_users_add.tt  view on Meta::CPAN

}

#----------------------------------------------------------------------------+
# Validate the form input, process the request.

sub submit {
    my ($self, $c) = @_;

    # convert the form input into hash data
    my %param = $c->plugin('CGI')->params($c);
    my %error;

    my $htpasswd = $c->config->{apache_doc_root} . '/conf/htpasswd';

    my $pwd = new Apache::Htpasswd($htpasswd);

    # check the username field data
    if ($param{username}) {
        unless ($param{username} =~ /\A (?: \w|\s|\-|\_){5,15} \z/x)
        {
            $error{username} = ERROR_USERNAME;
        }
        else {
            if ($pwd->fetchPass( $param{username} ) ) {
                $error{username} = ERROR_USERNAME_EXISTS;
            }
        }
    }
    else {
        $error{username} = ERROR_REQUIRED;
    }

    # check the password field data
    if ($param{password}) {
        unless ($param{password} =~ /\A (?: .){8,15} \z/x)
        {
            $error{password} = ERROR_PASSWORD;
        }
    }
    else {
        $error{password} = ERROR_REQUIRED;
    }

    unless (values %error) {

        my $username = $param{username};

        $param{username} =~ s/(\w+)/\#$1/gi;

        $pwd->htpasswd($param{username}, $param{password});

        $pwd->writeInfo($param{username}, time() );

        $self->SUPER::_log_action($c, "Added User ($username)");

        # list the users
        $self->_list_users($c);
    }
    else {

        $error{alert} = ERROR_FORM_INPUT;

        # errors exist, reload the form
        $self->_view_page( $c, \%param, \%error );
    }
}

1;

__END__

=head1 NAME

[% project_title %]::Admin::Users::Add - Web based admin control panel module

=head1 SYNOPSIS

  use [% project_title %]::Admin::Users::Add;

=head1 DESCRIPTION

Add a new user entry to the htpasswd file.

=head1 OBJECT METHODS

View the page.

  $self->_view_page(\%controller, \%param, \%error);

=head2 URI DISPATCHABLE

=head2 submit

Validate the form input, process the request.

  http://domain.com/app/admin/users/add/submit

=head1 SEE ALSO

L<Apache2::WebApp>, L<Apache2::WebApp::Admin>, L<Apache::Htpasswd>

=head1 AUTHOR

Marc S. Brooks, E<lt>mbrooks@cpan.orgE<gt> L<http://mbrooks.info>

=head1 COPYRIGHT

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut