OpenInteract::CommonHandler - Base class that with a few configuration items takes care of many common operations

 package MySite::Handler::MyTask;

 use strict;
 use OpenInteract::CommonHandler;

 @MySite::Handler::MyTask::ISA = qw( OpenInteract::CommonHandler );

 sub MY_PACKAGE                 { return 'mytask' }
 sub MY_HANDLER_PATH            { return '/MyTask' }
 sub MY_OBJECT_TYPE             { return 'myobject' }
 sub MY_OBJECT_CLASS            {
     return OpenInteract::Request->instance->myobject
 }
 sub MY_SEARCH_FIELDS {
     return qw( name type quantity purpose_in_life that_other.object_name )
 }
 sub MY_SEARCH_TABLE_LINKS      { return ( that_other => 'myobject_id' ) }
 sub MY_SEARCH_FORM_TITLE       { return 'Search for Thingies' }
 sub MY_SEARCH_FORM_TEMPLATE    { return 'search_form' }
 sub MY_SEARCH_RESULTS_TITLE    { return 'Thingy Search Results' }
 sub MY_SEARCH_RESULTS_TEMPLATE { return 'search_results' }
 sub MY_OBJECT_FORM_TITLE       { return 'Thingy Detail' }
 sub MY_OBJECT_FORM_TEMPLATE    { return 'form' }
 sub MY_EDIT_RETURN_URL         { return '/Thingy/search_form/' }
 sub MY_EDIT_FIELDS             {
     return qw( myobject_id name type quantity purpose_in_life )
 }
 sub MY_EDIT_FIELDS_TOGGLED     { return qw( is_indoctrinated ) }
 sub MY_EDIT_FIELDS_DATE        { return qw( birth_date ) }
 sub MY_ALLOW_SEARCH_FORM       { return 1 }
 sub MY_ALLOW_SEARCH            { return 1 }
 sub MY_ALLOW_SHOW              { return 1 }
 sub MY_ALLOW_CREATE            { return 1 }
 sub MY_ALLOW_EDIT              { return 1 }
 sub MY_ALLOW_REMOVE            { return undef }
 sub MY_ALLOW_WIZARD            { return undef }
 sub MY_ALLOW_NOTIFY            { return 1 }

 # My date format is for users to type in 'yyyymmdd'

 sub _read_field_date {
    my ( $class, $apr, $field ) = @_;
    my $date_value = $apr->param( $field );
    $date_value =~ s/\D//g;
    my ( $y, $m, $d ) = $date_value =~ /^(\d\d\d\d)(\d\d)(\d\d)$/;
    return undef unless ( $y and $m and $d );
    return join( '-', $y, $m, $d );
 }

 1;

 sub MY_SEARCH_FIELDS { return qw( login_name last_name group.name ) }

 $fieldname LIKE "$fieldvalue%"

 $fieldname LIKE "%$fieldvalue"

  sub MY_SEARCH_TABLE_LINKS { return ( address => 'user_id' ) }

 0: Fieldname in the object
 1: Fieldname in the other table

 sub MY_SEARCH_TABLE_LINKS {
     return ( person => [ 'person_id', 'person_id' ] ) }

  WHERE person.last_name LIKE '%mith%'
    AND phonelog.person_id = person.person_id

 0: ID field matching the object ID field on the linking table
 1: Name of the linking table
 2: Name of the ID field on the destination table

  user (user_id) <--> user_group (user_id, group_id) <--> group (group_id)

  sub MY_SEARCH_TABLE_LINKS {
      return ( group => [ 'user_id', 'user_group', 'group_id' ] ) }

  WHERE group.name LIKE '%admin%'
    AND group.group_id = user_group.group_id
    AND user_group.user_id = user.user_id

 sub MY_SEARCH_ADDITIONAL_PARAMS { return { skip_security => 1 } }

 sub _search_criteria_customize {
    my ( $class, $criteria ) = @_;
    $criteria->{'mytable.active'} = 'yes';
 }

 sub _search_build_where_customize {
     my ( $class, $table, $where, $value ) = @_;
     my $R = OpenInteract::Request->instance;
     my $search_date = $class->_read_field_date( 'pivot_date' );
     push @{ $where },
       "( TO_DAYS( ? ) BETWEEN ( TO_DAYS( pivot_date ) + 7 ) " .
       "AND ( TO_DAYS( pivot_date ) - 7 ) )";
     push @{ $value }, $search_date;
 }

 sub _show_customize {
     my ( $class, $params ) = @_;
     $params->{template_name} = ( $params->{object}{tmp_security_level} < SEC_LEVEL_WRITE )
                                  ? 'mypkg::static_display' : 'mypkg::form_display';
 }

 package My::Handler::MyHander;

 use OpenInteract::CommonHandler qw( OK ERROR );

 my %required_label = ( name => 'Name', quest => 'Quest',
                        favorite_color => 'Favorite Color' );

 # ... Override the various configuration routines ...

 sub _edit_customize {
     my ( $class, $object, $old_data ) = @_;
     my @msg = ();
     foreach my $field ( keys %required_label ) {
         if ( $object->{ $field } eq '' or ! defined $object->{ $field } ) {
            push @msg, "$required_label{ $field } is a required field. " .
                       "Please enter data for it.";
        }
     }
     return ( OK, undef ) unless ( scalar @msg );
     return ( ERROR, { error_msg => join( "<br>\n", @msg ),
                       method    => 'show' } );
 }

package OpenInteract::CommonHandler;

# $Id: CommonHandler.pm,v 1.44 2003/11/15 02:02:32 lachoy Exp $

use strict;
use Data::Dumper    qw( Dumper );
use OpenInteract::Handler::GenericDispatcher;
use SPOPS::Secure   qw( :level );
require Exporter;

@OpenInteract::CommonHandler::ISA       = qw( OpenInteract::Handler::GenericDispatcher );
$OpenInteract::CommonHandler::VERSION   = sprintf("%d.%02d", q$Revision: 1.44 $ =~ /(\d+)\.(\d+)/);
@OpenInteract::CommonHandler::EXPORT_OK = qw( OK ERROR );

use constant OK    => '1';
use constant ERROR => '4';


########################################
# SEARCH FORM
########################################

# Common handler method for a search form (easy)

sub search_form {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_SEARCH_FORM ) {
        $R->scrib( 0, "User requested search_form for ($class) and it's not allowed." );
        return '<h1>Error</h1><p>Objects of this type cannot be searched.</p>';
    }
    $p ||= {};

    my %params = %{ $p };
    $R->{page}{title} = $class->MY_SEARCH_FORM_TITLE;

    $class->_search_form_customize( \%params );
    my $template_name = $class->_template_name(
                                   \%params,
                                   $class->MY_SEARCH_FORM_TEMPLATE( \%params ) );
    return $R->template->handler( {}, \%params, { name => $template_name } );
}


########################################
# SEARCH
########################################

# Common handler method for a search

sub search {
    my ( $class, $p ) = @_;
    my $R   = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_SEARCH ) {
        $R->scrib( 0, "User requested search for ($class) and it's not allowed." );
        return '<h1>Error</h1><p>Objects of this type cannot be searched.</p>';
    }

    $p ||= {};
    my %params = %{ $p };

    my $apr = $R->apache;

    if ( $class->MY_SEARCH_RESULTS_PAGED ) {
        require OpenInteract::ResultsManage;
        my $search_id = $class->_search_get_id;
        my $results = OpenInteract::ResultsManage->new();

        # If the search has been run before, just set the ID

        if ( $search_id ) {
            $R->DEBUG && $R->scrib( 1, "Retrieving search for ID ($search_id)" );
            $results->{search_id} = $search_id;
        }

        # Otherwise, run the search and get an iterator back, then
        # pass the iterator to ResultsManage so we can reuse the
        # results

        else {
            $R->DEBUG && $R->scrib( 1, "Running search for the first time" );
            my ( $iterator, $msg ) =
                    eval { $class->_search_build_and_run({ %params, is_paged => 1 }) };

            # TODO: We will probably catch a specific exception here
            # when we use exceptions in OI

            if ( ! $iterator and $msg ) {
                my $cap_task = $class->MY_SEARCH_RESULTS_CAP_FAIL_TASK;
                return $class->$cap_task({ %params, error_msg => $msg });
            }

            if ( $@ ) {
                my $fail_task = $class->MY_SEARCH_FAIL_TASK;
                return $class->$fail_task({ %params, error_msg => "Search failed: $@" });
            }

            $results->save( $iterator );
            $R->DEBUG && $R->scrib( 1, "Search ID ($results->{search_id})" );
            $class->_search_save_id( $results->{search_id} );
        }

        if ( $results->{search_id} ) {
            $params{page_number_field} =  $class->MY_SEARCH_RESULTS_PAGE_FIELD;
            $params{current_page} = $apr->param( $params{page_number_field} ) || 1;
            my $hits_per_page     = $class->MY_SEARCH_RESULTS_PAGE_SIZE;
            my ( $min, $max )     = $results->find_page_boundaries(
                                                  $params{current_page}, $hits_per_page );
            $params{iterator}     = $results->retrieve({ min => $min, max => $max,
                                                         return => 'iterator' });
            $params{total_pages}  = $results->find_total_page_count( $hits_per_page );
            $params{total_hits}   = $results->{num_records};
            $params{search_id}    = $results->{search_id};
            $params{search_results_key} = $class->MY_SEARCH_RESULTS_KEY;
            $R->DEBUG && $R->scrib( 1, "Search info: min: ($min); max: ($max)",
                                       "records ($results->{num_records})" );
        }
    }

    # If we're not using paged results, then just run the normal
    # search and get back an iterator

    else {
        my ( $msg );
        ( $params{iterator}, $msg ) =
                    eval { $class->_search_build_and_run( \%params ) };

        # TODO: We will probably catch a specific exception here
        # when we use exceptions in OI

        if ( ! $params{iterator} and $msg ) {
            my $cap_task = $class->MY_SEARCH_RESULTS_CAP_FAIL_TASK;
            return $class->$cap_task({ %params, error_msg => $msg });
        }

        if ( $@ ) {
            my $fail_task = $class->MY_SEARCH_FAIL_TASK;
            $R->scrib( 0, "Got error from running search: $@" );
            return $class->$fail_task({ %params, error_msg => "Search failed: $@" });
        }
    }

    $R->{page}{title} = $class->MY_SEARCH_RESULTS_TITLE;

    $class->_search_customize( \%params );
    my $template_name = $class->_template_name(
                                   \%params,
                                   $class->MY_SEARCH_RESULTS_TEMPLATE( \%params ) );
    return $R->template->handler( {}, \%params, { name => $template_name } );
}


sub _search_get_id {
    my ( $class ) = @_;
    my $R = OpenInteract::Request->instance;
    my $search_key = $class->MY_SEARCH_RESULTS_KEY;
    return $R->apache->param( $search_key );
}


# If the handler wants to save the search ID elsewhere (session,
# etc.), override this

sub _search_save_id { return $_[1] }


# Build the search and run it, returning an iterator

sub _search_build_and_run {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;

    # Grab the criteria and customize if necessary

    my $criteria = $class->_search_build_criteria( $p );

    my ( $tables, $where, $values ) =
                    $class->_search_build_where_clause( $criteria, $p );

    my ( $limit );
    if ( $p->{min} or $p->{max} ) {
        if ( $p->{min} and $p->{max} ) { $limit = "$p->{min},$p->{max}" }
        elsif ( $p->{max} )            { $limit = $p->{max} }
    }

    my $object_class = $class->MY_OBJECT_CLASS;

    if ( my $num_limit_results = $class->MY_SEARCH_RESULTS_CAP ) {
        my $row = eval { $object_class->db_select({ select => [ 'count(*)' ],
                                                    from   => $tables,
                                                    where  => $where,
                                                    value  => $values,
                                                    return => 'single' }) };
        if ( $row->[0] > $num_limit_results ) {
            my $msg = "Your search has returned too many results. " .
                      "(Limit: $num_limit_results) Please try again.";
            return ( undef,  $msg );
        }
    }

    $R->DEBUG && $R->scrib( 1, "RUN SEARCH (before): ", scalar localtime );
    my $order = $class->MY_SEARCH_RESULTS_ORDER;
    my $additional_params = $class->MY_SEARCH_ADDITIONAL_PARAMETERS || {};
    my $iter = eval { $object_class->fetch_iterator({
                                         from       => $tables,  where => $where,
                                         value      => $values,  limit => $limit,
                                         order      => $order,
                                         %{ $additional_params } }) };
    $R->DEBUG && $R->scrib( 1, "RUN SEARCH (after): ", scalar localtime );

    return ( $iter, undef ) unless ( $@ );

    $R->scrib( 0, "Search failed: $@\nClass: $class\n",
                  "FROM", join( ',', @{ $tables } ), "\n",
                  "WHERE $where\n",
                  "ORDER BY $order\n",
                  "VALUES", join( ',', @{ $values } ) );
    die "Search failed ($@)\n";
}


# Grab the specified fields and values out of the form
# submitted. Fields with multiple values are saved as arrayrefs.

sub _search_build_criteria {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    my $apr = $R->apache;
    my $object_class = $class->MY_OBJECT_CLASS;
    my $object_table = $object_class->base_table;
    my ( %search_params );

    # Go through each search field and assign a value. If the search
    # field is a simple one (no table.field), then prepend the object
    # table to the fieldname

    foreach my $field ( $class->MY_SEARCH_FIELDS ) {
        my @value = $apr->param( $field );
        next unless ( defined $value[0] and $value[0] ne '' );
        my $full_field = ( $field =~ /\./ )
                           ? $field : "$object_table.$field";
        $search_params{ $full_field } = ( scalar @value > 1 )
                                          ? \@value : $value[0];
    }
    $class->_search_criteria_customize( \%search_params, $p );
    $R->DEBUG && $R->scrib( 1, "($class) Found search parameters:\n",
                               Dumper( \%search_params ) );
    return \%search_params
}


# Build a WHERE clause -- parameters with multiple values are 'OR',
# everything else is 'AND'. Example:
#
#  ( table.last_name LIKE '%win%' OR table.last_name LIKE '%smi%' )
#  AND ( table.first_name LIKE '%john%' )

sub _search_build_where_clause {
    my ( $class, $search_criteria, $p ) = @_;
    my $R = OpenInteract::Request->instance;

    # Find all our configured information

    my $object_class = $class->MY_OBJECT_CLASS;
    my $object_table = $object_class->base_table;
    my %from_tables  = ( $object_table => 1 );
    my %exact_match        = map { $_ => 1 } $class->_fq_fields( $class->MY_SEARCH_FIELDS_EXACT );
    my %left_exact_match   = map { $_ => 1 } $class->_fq_fields( $class->MY_SEARCH_FIELDS_LEFT_EXACT );
    my %right_exact_match  = map { $_ => 1 } $class->_fq_fields( $class->MY_SEARCH_FIELDS_RIGHT_EXACT );

    # Go through each of the criteria set -- note that each one must
    # be a fully-qualified (table.field) fieldname or it is discarded.

    my ( @where, @value ) = ();
    foreach my $field_name ( keys %{ $search_criteria } ) {
        $R->DEBUG && $R->scrib( 2, "Testing ($field_name) with ",
                                   "($search_criteria->{ $field_name })" );
        next unless ( defined $search_criteria->{ $field_name } );

        # Discard non-qualified fieldnames. Note that this regex will
        # greedily swallow everything to the last '.' to accommodate
        # systems that use a 'db.table' syntax to refer to a table.

        my ( $table ) = $field_name =~ /^([\w\.]*)\./;
        next unless ( $table );

        # Track the table used

        $from_tables{ $table }++;

        # See if we're using one or multiple values

        my $value_list = ( ref $search_criteria->{ $field_name } )
                           ? $search_criteria->{ $field_name }
                           : [ $search_criteria->{ $field_name } ];

        # Hold the items for this particular criterion, which will be
        # join'd with an 'OR'

        my @where_param = ();
        foreach my $value ( @{ $value_list } ) {

            # Value must be defined to be set

            next unless ( defined $value and $value ne '' );

            # Default is a LIKE match (see POD)

            my $oper         = ( $exact_match{ $field_name } ) ? '=' : 'LIKE';
            push @where_param, " $field_name $oper ? ";
            my ( $search_value );
            if ( $exact_match{ $field_name } ) {
                $search_value = $value;
            }
            elsif ( $left_exact_match{ $field_name } ) {
                $search_value = "$value%";
            }
            elsif ( $right_exact_match{ $field_name } ) {
                $search_value = "%$value";
            }
            else {
                $search_value = "%$value%";
            }
            push @value, $search_value;
            $R->DEBUG && $R->scrib( 2, "Set ($field_name) $oper ($search_value)" );
        }
        push @where, '( ' . join( ' OR ', @where_param ) . ' )';
    }

    # Generate any statements needed to link tables for searching.

    # DO NOT replace '@tables_used' in the foreach with 'keys
    # %from_tables' since we may add items to %from_tables during the
    # loop. Also don't do an 'each %table_links' and then check to see
    # if the table is in %from_tables for the same reason.

    my %table_links = $class->MY_SEARCH_TABLE_LINKS;
    my @tables_used = keys %from_tables;
    foreach my $link_table ( @tables_used ) {
        my $id_link = $table_links{ $link_table };
        next unless ( $id_link );

        # See POD for what the values in MY_SEARCH_TABLE_LINKS mean

        if ( ref $id_link eq 'ARRAY' ) {
            my $num_linking_fields = scalar @{ $id_link };
            if ( $num_linking_fields == 2 ) {
                my ( $object_field, $link_field ) = @{ $id_link };
                $R->DEBUG && $R->scrib( 1, "Linking ($link_table) with my field ",
                                           "($object_field) to ($link_field)" );
                push @where, join( ' = ', "$object_table.$object_field",
                                          "$link_table.$link_field" );
            }

            # Remember to add the linking table to our FROM list!

            elsif ( $num_linking_fields == 3 ) {
                my ( $base_id_field, $middle_table, $link_id_field ) = @{ $id_link };
                $R->DEBUG && $R->scrib( 1, "Linking to ($link_table) through ",
                                           "($middle_table)" );
                push @where, join( ' = ', "$object_table.$base_id_field",
                                          "$middle_table.$base_id_field" );
                push @where, join( ' = ', "$middle_table.$link_id_field",
                                          "$link_table.$link_id_field" );
                $from_tables{ $middle_table }++;
            }
            else {
                $R->scrib( 0, "Cannot generate a link clause for ",
                              "($link_table) from ($class)" );
                die "Cannot generate linking clauses for ($link_table) from ",
                    "($class): if value of hash is an array reference it ",
                    "must have either two or three elements.\n";
            }
        }
        else {
            $R->DEBUG && $R->scrib( 1, "Straight link to ($link_table) with",
                                       "($id_link)" );
            push @where, join( ' = ', "$object_table.$id_link",
                                      "$link_table.$id_link" );
        }
    }

    my @tables = keys %from_tables;
    $class->_search_build_where_customize( \@tables, \@where, \@value, $p );

    my $clause = join( " AND ", @where );
    $R->DEBUG && $R->scrib( 1, "($class) Built WHERE clause\n",
                                "FROM:", join( ', ', @tables ), "\n",
                                "WHERE: $clause\n",
                                "VALUES:", join( ', ', @value ) );
    return ( \@tables, $clause, \@value );
}


# Take a list of fields and ensure that each one is fully-qualified

sub _fq_fields {
    my ( $class, @fields ) = @_;
    my $object_class = $class->MY_OBJECT_CLASS;
    my $object_table = $object_class->base_table;
    return map { ( /\./ ) ? $_ : "$object_table.$_" } @fields;
}



########################################
# DISPLAY
########################################


sub create {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_CREATE ) {
        $R->scrib( 0, "User requested create for ($class) and it's not allowed." );
        return '<h1>Error</h1><p>New objects of this type cannot be created.</p>';
    }
    unless ( $p->{level} >= $class->MY_OBJECT_CREATE_SECURITY ) {
        $R->scrib( 0, "Request for create ($class) denied - inadequate security" );
        return '<h1>Error</h1><p>You do not have permission to create new objects.</p>';
    }
    $p->{edit}          = 1;
    $p->{is_new_object} = 1;
    return $class->show( $p );
}


sub show {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_SHOW ) {
        $R->scrib( 0, "User requested show for ($class) and it's not allowed." );
        return '<h1>Error</h1><p>Objects of this type cannot be viewed.</p>';
    }
    $p ||= {};

    my %params = %{ $p };

    # Assumption: Only users with SEC_LEVEL_WRITE can edit. Maybe
    # create configuration for: object_update_level,
    # object_create_level so we can have different security levels for
    # create and modify?

    $params{do_edit} = ( $p->{edit} or $R->apache->param( 'edit' ) );

    # Setup our default info

    my $fail_method  = $class->MY_SHOW_FAIL_TASK;
    my $object_type  = $class->MY_OBJECT_TYPE;
    my $object_class = $class->MY_OBJECT_CLASS;
    my $id_field     = $object_class->id_field;
    my $object = $object_class->new;
    unless ( $p->{is_new_object} ) {
        $object = $p->{ $object_type } ||
                  eval { $class->fetch_object( $p->{ $id_field }, $id_field ) };
        return $class->$fail_method({ %params, error_msg => $@ }) if ( $@ );
    }

    # If this is a saved object, see if we're supposed to ensure it's
    # active. If the user is an admin, it doesn't matter.

    my $active_field = $class->MY_ACTIVE_CHECK;
    if ( ! $R->{auth}{is_admin} and $object->is_saved and $active_field ) {
        my $status = $object->{ $active_field };
        unless ( $status =~ /^\s*(y|yes|1)\s*$/i ) {
            $R->scrib( 0, "Object failed 'active' status check (Status: $status)" );
            my $error_msg = "This object is currently inactive. Please check later.";
            return $class->$fail_method({ %params, error_msg => $error_msg });
        }
        $R->DEBUG && $R->scrib( 1, "Object passed 'active' status check (Status: $status)" );
    }

    # Ensure the object can be edited -- remember, 'fetch_object'
    # ALWAYS returns an object or dies, so don't add another clause
    # testing for the existence of $object

    unless ( $params{do_edit} or $object->is_saved ) {
        $R->scrib( 0, "User has requested static display on a new object -- bailing." );
        my $error_msg = 'Sorry, I could not display the object you requested.';
        return $class->search_form({ error_msg => $error_msg });
    }

    # Set both 'object' and the object type equal to the object so the
    # template can use either.

    $params{task_security} = $p->{level};
    $params{object} = $params{ $object_type } = $object;
    $R->{page}{title} = $class->MY_OBJECT_FORM_TITLE;

    $class->_show_customize( \%params );
    my $template_name = $class->_template_name(
                                   \%params,
                                   $class->MY_OBJECT_FORM_TEMPLATE( \%params ) );
    return $R->template->handler( {}, \%params, { name => $template_name } );
}



########################################
# MODIFY
########################################

sub edit {
    my ( $class, $p ) = @_;
    $p ||= {};
    my $R = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_EDIT ) {
        $R->scrib( 0, "User requested edit for ($class) and it's not allowed." );
        return '<h1>Error</h1><p>Objects of this type cannot be edited.</p>';
    }

    $R->{page}{return_url} = $class->MY_EDIT_RETURN_URL;

    # Setup default info

    my $fail_method  = $class->MY_EDIT_FAIL_TASK;
    my $object_type  = $class->MY_OBJECT_TYPE;
    my $object_class = $class->MY_OBJECT_CLASS;
    my $id_field     = $object_class->id_field;
    my $object       = eval { $class->fetch_object( $p->{ $id_field }, $id_field ) };

    # If we cannot fetch the object for editing, there's clearly a bad
    # error and we should go back to the search form rather than the
    # display form.

    if ( $@ ) {
        return $class->$fail_method({ %{ $p }, error_msg => $@ });
    }

    # Assumption: SEC_LEVEL_WRITE is necessary. (Probably ok.)

    my $is_new       = ( ! $object->is_saved );
    my $object_level = ( $is_new ) ? SEC_LEVEL_WRITE : $object->{tmp_security_level};
    if ( $object_level < SEC_LEVEL_WRITE ) {
        my $error_msg = 'Sorry, you do not have access to modify this ' .
                        'object. No modifications made.';
        return $class->$fail_method({ %{ $p }, error_msg => $error_msg });
    }

    $R->scrib( 1, "Object is new object? ", ( $is_new ) ? 'yes' : 'no' );

    # We pass this to the customization routine so you can do
    # comparisons, set off triggers based on changes, etc.

    my $old_data = $object->as_data_only;

    # Assign values from the form (specified by MY_EDIT_FIELDS,
    # MY_EDIT_FIELDS_DATE, MY_EDIT_FIELDS_TOGGLED, ...)

    $class->_edit_assign_fields( $object );

    # If after customizing/inspecting the object you want to bail and
    # go somewhere else, return the status 'ERROR' and fill \%opts
    # with information on what you want to do. (Overriding this is
    # quite common -- see POD.)

    my ( $status, $opts ) = $class->_edit_customize( $object, $old_data );
    if ( $status == ERROR ) {
        $opts->{object} = $opts->{ $object_type } = $object;
        return $class->_execute_options( $opts );
    }

    my %show_params = ( %{ $p }, $object_type => $object, object => $object );
    eval { $object->save( $opts ) };
    if ( $@ ) {
        my $ei = OpenInteract::Error->set( SPOPS::Error->get );
        $R->scrib( 0, "Object ($object_type) save failed: $@ ($ei->{system_msg})" );
        $R->throw({ code => 407 });
        $show_params{error_msg} = "Object modification failed. Error found: $ei->{system_msg}";
        return $class->$fail_method( \%show_params );
    }

    $class->_edit_post_action_customize( $object, $old_data );

    $show_params{status_msg} = ( $is_new )
                                 ? 'Object created properly.'
                                 : 'Object saved properly with changes.';
    my $method = $class->MY_EDIT_DISPLAY_TASK;
    return $class->$method( \%show_params );
}


# Assign values from GET/POST to the object

sub _edit_assign_fields {
    my ( $class, $object ) = @_;
    my $R = OpenInteract::Request->instance;
    my $apr = $R->apache;
    my $object_type = $class->MY_OBJECT_TYPE;

    # Go through normal fields

    foreach my $field ( $class->MY_EDIT_FIELDS ) {
        my $value = $class->_read_field( $apr, $field );
        $R->DEBUG && $R->scrib( 1, "Object edit: ($object_type) ($field) ($value)" );
        $object->{ $field } = $value;
    }

    # Go through toggled (yes/no) fields

    foreach my $field ( $class->MY_EDIT_FIELDS_TOGGLED ) {
        my $value = $class->_read_field_toggled( $apr, $field );
        $R->DEBUG && $R->scrib( 1, "Object edit toggle: ($object_type) ($field) ($value)" );
        $object->{ $field } = $value;
    }

    # Go through date fields

    foreach my $field ( $class->MY_EDIT_FIELDS_DATE ) {
        my $value = $class->_read_field_date( $apr, $field );
        $R->DEBUG && $R->scrib( 1, "Object edit date: ($object_type) ($field) ($value)" );
        $object->{ $field } = $value;
    }

    # Go through datetime fields

    foreach my $field ( $class->MY_EDIT_FIELDS_DATETIME ) {
        my $value = $class->_read_field_datetime( $apr, $field );
        $R->DEBUG && $R->scrib( 1, "Object edit datetime: ($object_type) ($field) ($value)" );
        $object->{ $field } = $value;
    }

    return ( OK, undef );
}


########################################
# READ FIELDS
########################################

# Just return the value

sub _read_field {
    my ( $class, $apr, $field ) = @_;
    return $apr->param( $field );
}


# If any value, return 'yes', otherwise 'no'

sub _read_field_toggled {
    my ( $class, $apr, $field ) = @_;
    return ( $apr->param( $field ) ) ? 'yes' : 'no';
}


# Default is to have the year, month and day in three separate fields.

sub _read_field_date {
    my ( $class, $apr, $field ) = @_;
    my ( $y, $m, $d ) = ( $apr->param( $field . '_year' ),
                          $apr->param( $field . '_month' ),
                          $apr->param( $field . '_day' ) );
    return undef unless ( $y and $m and $d );
    return join( '-', $y, $m, $d );
}


sub _read_field_datetime {
    my ( $class, $apr, $field ) = @_;
    my $date = $class->_read_field_date( $apr, $field );
    return undef unless ( $date );
    my ( $h, $m, $am_pm ) = ( $apr->param( $field . '_hour' ),
                              $apr->param( $field . '_minute' ),
                              $apr->param( $field . '_am_pm' ) );
    unless ( $h and $m and $am_pm ) {
        $h = '12'; $m = '00'; $am_pm = 'AM';
    }
    return join( ' ', $date, "$h:$m $am_pm" );
}


sub _read_field_date_object {
    my ( $class, $apr, $field ) = @_;
    my $date = $class->_read_field_date( $apr, $field );
    return Class::Date->new( $date );
}


########################################
# REMOVE
########################################

sub remove {
    my ( $class, $p ) = @_;
    $p ||= {};
    my $R = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_REMOVE ) {
        $R->scrib( 0, "User requested remove for ($class) and it's not allowed." );
        return $class->search_form({
                  error_msg => 'Objects of this type cannot be removed.' });
    }

    my $apr = $R->apache;

    my $fail_method  = $class->MY_REMOVE_FAIL_TASK;
    my $object_type  = $class->MY_OBJECT_TYPE;
    my $object_class = $class->MY_OBJECT_CLASS;
    my $id_field     = $object_class->id_field;
    my $object       = eval { $class->fetch_object( $p->{ $id_field },
                                                    $id_field ) };

    if ( $@ ) {
        return $class->$fail_method({ %{ $p }, error_msg => $@ });
    }
    unless ( $object->is_saved ) {
        my $error_msg = 'Cannot fetch object for removal. No modifications made.';
        return $class->$fail_method({ %{ $p }, error_msg => $error_msg });
    }


    # Assumption: SEC_LEVEL_WRITE is necessary to remove. (Probably ok.)

    if ( $object->{tmp_security_level} < SEC_LEVEL_WRITE ) {
        my $error_msg = 'Sorry, you do not have access to remove this ' .
                        'object. No modifications made.';
        return $class->$fail_method({ %{ $p }, error_msg => $error_msg });
    }

    my %show_params = %{ $p };

    $class->_remove_customize( $object );
    eval { $object->remove };
    if ( $@ ) {
        my $ei = OpenInteract::Error->set( SPOPS::Error->get );
        $R->scrib( 0, "Cannot remove object ($object_type) ($@) ($ei->{system_msg})" );
        $R->throw({ code => 405 });
        $show_params{error_msg} = "Cannot remove object! See error log.";
        return $class->$fail_method( \%show_params );
    }

    $class->_remove_post_action_customize( $object );

    $show_params{status_msg} = 'Object successfully removed.';
    my $method = $class->MY_REMOVE_DISPLAY_TASK;
    return $class->$method( \%show_params );
}



########################################
# NOTIFY
########################################


sub notify {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_NOTIFY ) {
        $R->scrib( 0, "User requested notify for ($class) and it's not allowed." );
        return '<h1>Error</h1><p>Objects of this type cannot be sent.';
    }

    my $apr = $R->apache;
    my $object_class = $class->MY_OBJECT_CLASS;
    my @id_list      = $p->{id_list} || $apr->param( $class->MY_NOTIFY_ID_FIELD );
    my $email        = $p->{email}   || $apr->param( $class->MY_NOTIFY_EMAIL_FIELD );
    unless ( $email ) {
        return '<h2 align="center">Error</h2>' .
               '<p>Error: Cannot run notification: no email address given.</p>';
    }
    unless ( scalar @id_list ) {
        return '<h2 align="center">Error</h2>' .
               '<p>Error: Cannot run notification: no objects specified.</p>';
    }

    my @object_list = ();
    foreach my $id ( @id_list ) {
        my $object = eval { $object_class->fetch( $id ) };
        push @object_list, $object    if ( $object );
    }
    my %params = ( from_email => $class->MY_NOTIFY_FROM,
                   email      => $email,
                   subject    => $class->MY_NOTIFY_SUBJECT,
                   object     => \@object_list,
                   notes      => $apr->param( $class->MY_NOTIFY_NOTES_FIELD ),
                   type       => $class->MY_OBJECT_TYPE );
    $class->_notify_customize( \%params );
    if ( OpenInteract::SPOPS->notify( \%params ) ) {
        return '<h2 align="center">Success!</h2>' .
               '<p>Notification sent properly!</p>';
    }
    return '<h2 align="center">Error</h2>' .
           '<p>Error sending email. Please check error logs!</p>';
}


########################################
# WIZARD
########################################

# Wizard stuff is pretty simple -- a lot of the difficult stuff is done
# via javascript.


# Start the wizard (simple search form, usually)

sub wizard {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_WIZARD ) {
        $R->scrib( 0, "User requested wizard for ($class) and it's not allowed." );
        return '<h1>Error</h1><p>The wizard is not enabled for these objects.</p>';
    }
    $p ||= {};

    my %params = %{ $p };

    $R->{page}{title} = $class->MY_WIZARD_FORM_TITLE;
    $R->{page}{_simple_}++;

    $class->_wizard_form_customize( \%params );
    my $template_name = $class->_template_name(
                                   \%params,
                                   $class->MY_WIZARD_FORM_TEMPLATE( \%params ) );
    return $R->template->handler( {}, \%params, { name => $template_name } );
}


# Run the search and present results; note that we truncate the
# iterator results with a max of 50, so we don't have any issues with
# paged results or with the user typing 'a' for a last name and
# getting back 100000 items...

sub wizard_search {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    unless ( $class->MY_ALLOW_WIZARD ) {
        $R->scrib( 0, "User requested wizard search for ($class) and it's not allowed." );
        return '<h1>Error</h1><p>The wizard is not enabled for these objects.</p>';
    }
    $p ||= {};

    my %params = %{ $p };
    ( $params{iterator}, $params{msg} ) =
                    $class->_search_build_and_run({ max => $class->MY_WIZARD_RESULTS_MAX });

    $R->{page}{title} = $class->MY_WIZARD_RESULTS_TITLE;
    $R->{page}{_simple_}++;

    $class->_wizard_search_customize( \%params );
    my $template_name = $class->_template_name(
                                   \%params,
                                   $class->MY_WIZARD_RESULTS_TEMPLATE( \%params ) );
    return $R->template->handler( {}, \%params, { name => $template_name } );
}



########################################
# TASK FLOW MANIPULATION
########################################

# Find relevant information in \%opts to execute. Potential information:
#  - class, method --> what to execute; if 'method' specified but not
#  'class', we use our own class
#  - action --> Lookup the action and pass in $opts
#  - error_msg: error message to pass around
#  - status_msg: status message to pass around
#  ... Whatever else is passed along

# Currently only used in edit()

sub _execute_options {
    my ( $class, $opts ) = @_;
    my $R = OpenInteract::Request->instance;
    if ( my $method = $opts->{method} ) {
        my $execute_class = $opts->{class} || $class;
        $R->DEBUG && $R->scrib( 1, "Executing ($execute_class) ($method) after bail." );
        return $execute_class->$method( $opts );
    }

    if ( $opts->{action} ) {
        my ( $execute_class, $method ) = $R->lookup_action( $opts->{action} );
        if ( $execute_class and $method ) {
            $R->DEBUG && $R->scrib( 1, "Executing ($execute_class) ($method) ",
                                       "from ($opts->{action} after bail." );
            return $execute_class->$method( $opts );
        }
    }
    return "Cannot find next execute operation.";
}



########################################
# GENERIC OBJECT FETCH
########################################

# ALWAYS RETURNS OBJECT OR DIES

# Retrieve a record: if no $id then return a new one; if $id throw a
# error and die if we cannot fetch; if object with $id not found,
# return a new one. You can always tell if the returned object is new
# by the '->is_saved()' flag (false if new, true if existing)

sub fetch_object {
    my ( $class, $id, @id_field_list ) = @_;
    my $R = OpenInteract::Request->instance;

    unless ( $id ) {
        my $apr = $R->apache;
        foreach my $id_field ( @id_field_list ) {
            $id = $apr->param( $id_field );
            last if ( $id );
        }
    }

    my $object_class = $class->MY_OBJECT_CLASS;

    return $object_class->new  unless ( $id );

    my $object = eval { $object_class->fetch( $id ) };
    unless ( $@ ) {
        $object ||= $object_class->new;
        $class->_fetch_object_customize( $object );
        return $object;
    }

    my $ei = OpenInteract::Error->set( SPOPS::Error->get );
    my $error_msg = undef;
    if ( $ei->{type} eq 'security' ) {
        $error_msg = "Permission denied: you do not have access to view " .
                     "the requested object. ";
    }
    else {
        $R->throw({ code => 404 });
        $error_msg = "Error encountered trying to retrieve object. The " .
                     "error has been logged. "
    }
    die "$error_msg\n";
}


########################################
# OTHER
########################################

# Common template name specification

sub _template_name {
    my ( $class, $p, $default_name ) = @_;
    return $p->{template_name} if ( $p->{template_name} );
    my $package  = $class->MY_PACKAGE;
    my $template = $default_name;
    return join( '::', $package, $template );
}


########################################
# MANDATORY CONFIGURATION
########################################

sub MY_PACKAGE {
    die "Please define class method MY_PACKAGE() in $_[0]\n";
}
sub MY_OBJECT_TYPE {
    die "Please define class method MY_OBJECT_TYPE() in $_[0]\n";
}


########################################
# DEFAULT CONFIGURATION
########################################

sub MY_HANDLER_PATH            { return '/' . $_[0]->MY_OBJECT_TYPE }
sub MY_OBJECT_CLASS {
    my $object_type = $_[0]->MY_OBJECT_TYPE;
    return OpenInteract::Request->instance->$object_type();
}

sub MY_ALLOW_SEARCH_FORM         { return 1 }
sub MY_SEARCH_FORM_TITLE         { return 'Search Form' }
sub MY_SEARCH_FORM_TEMPLATE      { return 'search_form' }

sub MY_ALLOW_SEARCH              { return 1 }
sub MY_SEARCH_FIELDS             { return () }
sub MY_SEARCH_FIELDS_EXACT       { return () }
sub MY_SEARCH_FIELDS_LEFT_EXACT  { return () }
sub MY_SEARCH_FIELDS_RIGHT_EXACT { return () }
sub MY_SEARCH_TABLE_LINKS        { return () }
sub MY_SEARCH_ADDITIONAL_PARAMETERS { return {} }
sub MY_SEARCH_FAIL_TASK          { return 'search_form' }
sub MY_SEARCH_RESULTS_CAP        { return 0 }
sub MY_SEARCH_RESULTS_CAP_FAIL_TASK { return 'search_form' }
sub MY_SEARCH_RESULTS_ORDER      { return undef }
sub MY_SEARCH_RESULTS_PAGED      { return undef }
sub MY_SEARCH_RESULTS_KEY        { return $_[0]->MY_OBJECT_TYPE . '_search_id' }
sub MY_SEARCH_RESULTS_PAGE_SIZE  { return 50 }
sub MY_SEARCH_RESULTS_PAGE_FIELD { return 'pagenum' }
sub MY_SEARCH_RESULTS_TITLE      { return 'Search Results' }
sub MY_SEARCH_RESULTS_TEMPLATE   { return 'search_results' }

sub MY_ALLOW_SHOW                { return 1 }
sub MY_SHOW_FAIL_TASK            { return 'search_form' }
sub MY_ACTIVE_CHECK              { return undef }
sub MY_OBJECT_FORM_TITLE         { return 'Object Detail' }
sub MY_OBJECT_FORM_TEMPLATE      { return 'object_form' }

sub MY_ALLOW_CREATE              { return undef }
sub MY_OBJECT_CREATE_SECURITY    { return SEC_LEVEL_WRITE }

sub MY_ALLOW_EDIT                { return undef }
sub MY_EDIT_RETURN_URL           { return $_[0]->MY_HANDLER_PATH . '/' }
sub MY_EDIT_FIELDS               { return () }
sub MY_EDIT_FIELDS_TOGGLED       { return () }
sub MY_EDIT_FIELDS_DATE          { return () }
sub MY_EDIT_FIELDS_DATETIME      { return () }
sub MY_EDIT_FAIL_TASK            { return 'search_form' }
sub MY_EDIT_DISPLAY_TASK         { return 'show' }

sub MY_ALLOW_REMOVE              { return undef }
sub MY_REMOVE_FAIL_TASK          { return 'search_form' }
sub MY_REMOVE_DISPLAY_TASK       { return 'search_form' }

sub MY_ALLOW_NOTIFY              { return undef }
sub MY_NOTIFY_FROM               { return undef }
sub MY_NOTIFY_SUBJECT            { return '' }
sub MY_NOTIFY_ID_FIELD           { my $oc = $_[0]->MY_OBJECT_CLASS; return $oc->id_field }
sub MY_NOTIFY_EMAIL_FIELD        { return 'email' }
sub MY_NOTIFY_NOTES_FIELD        { return 'notes' }

sub MY_ALLOW_WIZARD              { return undef }
sub MY_WIZARD_FORM_TITLE         { return 'Wizard: Search' }
sub MY_WIZARD_FORM_TEMPLATE      { return 'wizard_form' }
sub MY_WIZARD_RESULTS_MAX        { return 50 }
sub MY_WIZARD_RESULTS_TITLE      { return 'Wizard: Results' }
sub MY_WIZARD_RESULTS_TEMPLATE   { return 'wizard_results' }


########################################
# CUSTOMIZATION INTERFACE
########################################

# Template/param modifications
sub _search_form_customize        { return 1 }
sub _search_customize             { return 1 }
sub _show_customize               { return 1 }
sub _notify_customize             { return 1 }
sub _wizard_form_customize        { return 1 }
sub _wizard_search_customize      { return 1 }

# Criteria/Object modifications
sub _search_criteria_customize    { return $_[1] }
sub _search_build_where_customize { return 1 }
sub _fetch_object_customize       { return $_[1] }
sub _edit_customize               { return ( OK, undef ) }
sub _edit_post_action_customize   { return 1 }
sub _remove_customize             { return 1 }
sub _remove_post_action_customize { return 1 }


1;

__END__