See Data::FormValidator::Constraints for a full list of available constraints.

package Apps::Store::Register;

use strict;

use base 'Apps::Store';

use Gantry::Utils::FormMunger;
use Data::FormValidator;
use Gantry::Utils::CRUDHelp qw( clean_params form_profile write_file );

use Data::FormValidator::Constraints qw( :closures );

sub do_main {
   my ( $self  ) = @_;

   $self->stash->view->template( 'register.tt' );
   $self->stash->view->title( 'Register' );

   my $params       = $self->get_param_hash();    

   my $form = Apps::Store::GEN::User::form( $self );

   my $munger = Gantry::Utils::FormMunger->new( $form );

   # set custom constraint
   $munger->set_props( 'username', { 
       constraint => sub { 
           my ($dfv, $val) = @_;                
           return check_username( $self, $dfv, $val ); 
       }, 
   } );

   # set custom constraint
   $munger->set_props( 'nickname', { 
       constraint => sub { 
          my ($dfv, $val) = @_;                
          return check_nickname( $self, $dfv, $val ); 
       }, 
   } );

   # set zip and email constraints provided by 
   # the Data::FormValidator::Constraints
   $munger->set_props( 'email', { constraint => email() } );
   $munger->set_props( 'zip',     { constraint => zip() } ); 

   # stash the new form        
   $self->stash->view->form( $form );

   if ( $self->is_post() ) { 
       my $results = Data::FormValidator->check( $params,
           form_profile( $form->{fields} ),
       );

       # looks like errors
       if ( $results->has_invalid || $results->has_missing  ) { 
           $self->stash->view->form->results( $results );
       }
       # looks good, make update
       else {                
           clean_params( $params, $form->{fields} );
           delete( $params->{submit} );

           # make the update
           my $sch  = $self->get_schema();
           my $user = $sch->resultset( 'user' )->create( $params );

          # and we're done
          $self->relocate( $self->location . "/complete" );
       }
    } 
} # END do_main

# ------- check username
sub check_username {
    my ( $self, $dfv, $user ) = @_;

    if ( length( $user ) < 4  ) {
        $dfv->set_current_constraint_name('- to short');
        return undef;        
    }
    elsif ( length( $user ) > 16 ) {
        $dfv->set_current_constraint_name('- to long');
        return undef;
    }      
    else {
        my $sch = $self->get_schema();    
        my $user_row = $sch->resultset( 'user' )->search( 
            username => $user,
        )->next;

        if ( $user_row ) {
            $dfv->set_current_constraint_name('- taken');
            return undef;
        }   

    }

   return $user;

}

# ------- check nickname
sub check_nickname {
    my ( $self, $dfv, $nick ) = @_;

    if ( length( $nick ) < 4  ) {
        $dfv->set_current_constraint_name('- to short');
        return undef;        
    }
    elsif ( length( $nick ) > 16 ) {
        $dfv->set_current_constraint_name('- to long');
        return undef;
    }      
    else {
        my $sch = $self->get_schema();    
        my $nick_row = $sch->resultset( 'user' )->search( 
            nickname => $nick,
        )->next;

        if ( $nick_row ) {
            $dfv->set_current_constraint_name('- taken');
            return undef;
        }   

    }

    return $nick;

}