view release on metacpan or  search on metacpan

Perform.pm  view on Meta::CPAN

#    $GlobalUi->update_info_message( $form, 'next' );
    $GlobalUi->clear_display_error;
    $form->setField( 'DONTSWITCH', 1 );
    $GlobalUi->clear_display_error;

    if ( $RowList->is_empty ) {
        $GlobalUi->display_error('no16.');
        $app->{deletedrow} = 0;
        return;
    }
    if ( $RowList->is_last ) {
        my $row = $RowList->current_row;
        display_row( $form, $row );

        # at the end of the list, switch to "Next" button
        $form->getWidget('ModeButtons')->setField( 'VALUE', 1 );
        $GlobalUi->display_error('no41.');
#        $GlobalUi->update_info_message( $form, 'next' );
        return unless $app->{deletedrow};
    }
    my $distance = $app->{'number'};
    $distance = 1 unless $distance;
    $distance = 0 if $app->{deletedrow};
    $app->{deletedrow} = 0;

    # Perform counts down from the most recent fetch (up for prev)
    my $row = $RowList->next_row($distance);
    display_row( $form, $row );

    if (my $row_status = refresh_row(1, 1)) {
        if ($row_status == 2) {
            $GlobalUi->display_error('so35.');
        } else {
            $GlobalUi->display_error('so34.');
        }
    }
}

sub addmode {
    warn "TRACE: entering addmode\n" if $::TRACE;
    return if changemode( 'add', \&addmode_resume );

    my $form    = $GlobalUi->get_current_form;
    my $subform = $form->getSubform('DBForm') || $form;
    my $fl      = $GlobalUi->get_field_list;

    $GlobalUi->clear_comment_and_error_display;

    # initalize any serial or default fields to screen
    $fl->display_defaults_to_screen($GlobalUi);

    warn "TRACE: leaving addmode\n" if $::TRACE;
}

sub addmode_resume {
    my $subform = shift;
    addmode(@_);
    $subform->setField( 'FOCUSED', 'DBForm' );
}

sub updatemode {
    my $form = $GlobalUi->get_current_form;

#    $GlobalUi->update_info_message( $form, 'update' );
    return if check_rows_and_advise($form);

    return if changemode( 'update', \&updatemode_resume );

    $GlobalUi->clear_comment_and_error_display;

    my $subform = $form->getSubform('DBForm');
    my $fl      = $GlobalUi->get_field_list;

    my $row = $RowList->current_row;

    $fl->reset;
    while ( my $f = $fl->iterate_list ) {
        my ( $ft, $tbl, $col ) = $f->get_names;
        my $w = $subform->getWidget($ft);
        next unless $col;
    }
}

sub updatemode_resume {
    my ($form) = @_;
    updatemode(@_);
    $form->setField( 'FOCUSED', 'DBForm' );
}

# sub edit_control  #replaced with Perform::Instruct::trigger_ctrl_blk

sub removemode {
    my $key  = shift;
    my $form = shift;

    my %info_msgs = %{ $GlobalUi->{info_messages} };
    my %err_msgs  = %{ $GlobalUi->{error_messages} };
    my @buttons   = $GlobalUi->{buttons_yn};
    my $app       = $GlobalUi->{app_object};

#    $GlobalUi->update_info_message( $form, 'remove' );
    $form->setField( 'DONTSWITCH', 1 );
    $GlobalUi->clear_comment_and_error_display;

    return if check_rows_and_advise($form);

    #'before remove' only works on tables.  Don't believe it makes any
    # sense to trigger off a column-- the smallest element that can be
    # removed is 1 row.
    my $table = $GlobalUi->get_current_table_name;
    my $actkey = trigger_ctrl_blk( 'before', 'remove', $table );
    return if $actkey eq "\cC";

    $GlobalUi->switch_buttons( $form );
#    $GlobalUi->update_info_message( $form, 'yes' );
    my $wid    = $form->getWidget('ModeButtons');
    $wid->setField('VALUE', 0);
}

sub do_remove {

    #my $key = shift;
    #my $form = shift;

    warn "TRACE: entering do_remove\n" if $::TRACE;

    my $app  = $GlobalUi->{app_object};
    my $form = $GlobalUi->get_current_form;
#    $GlobalUi->update_info_message( $form, 'remove' );

    return if check_rows_and_advise($form);

    my $table = $GlobalUi->get_current_table_name;

    my $subform = $form->getSubform('DBForm');
    my $fl      = $GlobalUi->get_field_list;

    my @wheres = ();
    my @values = ();

    my $row     = $RowList->current_row;
    my $aliases = $app->{'aliases'};

    my $ralias = $aliases->{"$table.rowid"};